-- Copyright (c) 2011-2015, David Amos. All rights reserved.

{-# LANGUAGE NoMonomorphismRestriction, DeriveFunctor #-}

-- |A module providing functions to construct and investigate (small, finite) matroids.
module Math.Combinatorics.Matroid where

-- Source: Oxley, Matroid Theory (second edition)

import Math.Core.Utils
import Math.Core.Field hiding (f7)

import Math.Common.ListSet as LS -- set operations on strictly ascending lists
-- import Math.Algebra.Field.Base hiding (Q, F2, F3, F5, F7, F11, f2, f3, f5, f7, f11)
import Math.Algebra.LinearAlgebra hiding (rank)

import qualified Math.Combinatorics.Graph as G -- hiding (combinationsOf, restriction, component, isConnected)
import Math.Combinatorics.FiniteGeometry
import Math.Combinatorics.GraphAuts
import Math.Algebra.Group.PermutationGroup hiding (closure)

import Math.Algebras.VectorSpace hiding (dual)
import Math.Algebras.Structures
import Math.Algebras.Commutative

import Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

implies :: Bool -> Bool -> Bool
implies p :: Bool
p q :: Bool
q = Bool
q Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
p
exists :: t a -> Bool
exists = Bool -> Bool
not (Bool -> Bool) -> (t a -> Bool) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
unique :: [a] -> a
unique [x :: a
x] = a
x

shortlex :: t a -> t a -> Ordering
shortlex xs :: t a
xs ys :: t a
ys = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
xs) (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ys) of
    LT -> Ordering
LT
    EQ -> t a -> t a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t a
xs t a
ys
    GT -> Ordering
GT

isShortlex :: [t a] -> Bool
isShortlex xs :: [t a]
xs = (t a -> t a -> Bool) -> [t a] -> Bool
forall b. (b -> b -> Bool) -> [b] -> Bool
foldcmpl (\x1 :: t a
x1 x2 :: t a
x2 -> t a -> t a -> Ordering
forall (t :: * -> *) a.
(Foldable t, Ord (t a)) =>
t a -> t a -> Ordering
shortlex t a
x1 t a
x2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT) [t a]
xs

toShortlex :: [t a] -> [t a]
toShortlex xs :: [t a]
xs = ((Int, t a) -> t a) -> [(Int, t a)] -> [t a]
forall a b. (a -> b) -> [a] -> [b]
map (Int, t a) -> t a
forall a b. (a, b) -> b
snd ([(Int, t a)] -> [t a]) -> [(Int, t a)] -> [t a]
forall a b. (a -> b) -> a -> b
$ [(Int, t a)] -> [(Int, t a)]
forall a. Ord a => [a] -> [a]
L.sort [(t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
x, t a
x) | t a
x <- [t a]
xs]

isClutter :: [[a]] -> Bool
isClutter ss :: [[a]]
ss = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ ([a]
s1 [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`LS.isSubset` [a]
s2) Bool -> Bool -> Bool
`implies` ([a]
s1 [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
s2) | [a]
s1 <- [[a]]
ss, [a]
s2 <- [[a]]
ss ]
-- note that this definition would allow duplicates

-- single-element deletions of xs
-- if xs is sorted, then so is reverse (deletions xs)
deletions :: [a] -> [[a]]
deletions xs :: [a]
xs = ([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([a] -> [[a]]
forall a. [a] -> [[a]]
inits [a]
xs) ([[a]] -> [[a]]
forall a. [a] -> [a]
tail ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. [a] -> [[a]]
tails [a]
xs)

closedUnderSubsets :: [[a]] -> Bool
closedUnderSubsets xss :: [[a]]
xss = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [[a]
xs' [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
xss' | [a]
xs <- [[a]]
xss, [a]
xs' <- [a] -> [[a]]
forall a. [a] -> [[a]]
deletions [a]
xs]
    where xss' :: Set [a]
xss' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
xss


-- |The data structure that we use to store the bases of the matroid
data TrieSet a = TS [(a, TrieSet a)] deriving (TrieSet a -> TrieSet a -> Bool
(TrieSet a -> TrieSet a -> Bool)
-> (TrieSet a -> TrieSet a -> Bool) -> Eq (TrieSet a)
forall a. Eq a => TrieSet a -> TrieSet a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrieSet a -> TrieSet a -> Bool
$c/= :: forall a. Eq a => TrieSet a -> TrieSet a -> Bool
== :: TrieSet a -> TrieSet a -> Bool
$c== :: forall a. Eq a => TrieSet a -> TrieSet a -> Bool
Eq,Eq (TrieSet a)
Eq (TrieSet a) =>
(TrieSet a -> TrieSet a -> Ordering)
-> (TrieSet a -> TrieSet a -> Bool)
-> (TrieSet a -> TrieSet a -> Bool)
-> (TrieSet a -> TrieSet a -> Bool)
-> (TrieSet a -> TrieSet a -> Bool)
-> (TrieSet a -> TrieSet a -> TrieSet a)
-> (TrieSet a -> TrieSet a -> TrieSet a)
-> Ord (TrieSet a)
TrieSet a -> TrieSet a -> Bool
TrieSet a -> TrieSet a -> Ordering
TrieSet a -> TrieSet a -> TrieSet 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 a. Ord a => Eq (TrieSet a)
forall a. Ord a => TrieSet a -> TrieSet a -> Bool
forall a. Ord a => TrieSet a -> TrieSet a -> Ordering
forall a. Ord a => TrieSet a -> TrieSet a -> TrieSet a
min :: TrieSet a -> TrieSet a -> TrieSet a
$cmin :: forall a. Ord a => TrieSet a -> TrieSet a -> TrieSet a
max :: TrieSet a -> TrieSet a -> TrieSet a
$cmax :: forall a. Ord a => TrieSet a -> TrieSet a -> TrieSet a
>= :: TrieSet a -> TrieSet a -> Bool
$c>= :: forall a. Ord a => TrieSet a -> TrieSet a -> Bool
> :: TrieSet a -> TrieSet a -> Bool
$c> :: forall a. Ord a => TrieSet a -> TrieSet a -> Bool
<= :: TrieSet a -> TrieSet a -> Bool
$c<= :: forall a. Ord a => TrieSet a -> TrieSet a -> Bool
< :: TrieSet a -> TrieSet a -> Bool
$c< :: forall a. Ord a => TrieSet a -> TrieSet a -> Bool
compare :: TrieSet a -> TrieSet a -> Ordering
$ccompare :: forall a. Ord a => TrieSet a -> TrieSet a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (TrieSet a)
Ord,a -> TrieSet b -> TrieSet a
(a -> b) -> TrieSet a -> TrieSet b
(forall a b. (a -> b) -> TrieSet a -> TrieSet b)
-> (forall a b. a -> TrieSet b -> TrieSet a) -> Functor TrieSet
forall a b. a -> TrieSet b -> TrieSet a
forall a b. (a -> b) -> TrieSet a -> TrieSet b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TrieSet b -> TrieSet a
$c<$ :: forall a b. a -> TrieSet b -> TrieSet a
fmap :: (a -> b) -> TrieSet a -> TrieSet b
$cfmap :: forall a b. (a -> b) -> TrieSet a -> TrieSet b
Functor)
-- Note that in a trie we would normally have a Bool at each node saying whether or not the node is terminal
-- (ie corresponds to a member and not just a prefix of a member).
-- However, since we intend to use the trie to store the bases, and they are all the same length,
-- we can use lack of children to detect that a node is terminal.

-- We could try storing the children in a map rather than a list

-- for debugging
tsshow :: TrieSet a -> [Char]
tsshow (TS xts :: [(a, TrieSet a)]
xts) = "TS [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ((a, TrieSet a) -> [Char]) -> [(a, TrieSet a)] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(x :: a
x,t :: TrieSet a
t) -> "(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "," [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TrieSet a -> [Char]
tsshow TrieSet a
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ")") [(a, TrieSet a)]
xts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "]"

instance Show a => Show (TrieSet a) where
    show :: TrieSet a -> [Char]
show = [[a]] -> [Char]
forall a. Show a => a -> [Char]
show ([[a]] -> [Char]) -> (TrieSet a -> [[a]]) -> TrieSet a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrieSet a -> [[a]]
forall a. TrieSet a -> [[a]]
tstolist

tsempty :: TrieSet a
tsempty = [(a, TrieSet a)] -> TrieSet a
forall a. [(a, TrieSet a)] -> TrieSet a
TS []

tsinsert :: [a] -> TrieSet a -> TrieSet a
tsinsert (x :: a
x:xs :: [a]
xs) (TS ts :: [(a, TrieSet a)]
ts) =
    case a -> [(a, TrieSet a)] -> Maybe (TrieSet a)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup a
x [(a, TrieSet a)]
ts of
    Nothing -> let t :: TrieSet a
t = [a] -> TrieSet a -> TrieSet a
tsinsert [a]
xs ([(a, TrieSet a)] -> TrieSet a
forall a. [(a, TrieSet a)] -> TrieSet a
TS [])
               in [(a, TrieSet a)] -> TrieSet a
forall a. [(a, TrieSet a)] -> TrieSet a
TS ([(a, TrieSet a)] -> TrieSet a) -> [(a, TrieSet a)] -> TrieSet a
forall a b. (a -> b) -> a -> b
$ (a, TrieSet a) -> [(a, TrieSet a)] -> [(a, TrieSet a)]
forall a. Ord a => a -> [a] -> [a]
L.insert (a
x,TrieSet a
t) [(a, TrieSet a)]
ts
    Just t :: TrieSet a
t -> let t' :: TrieSet a
t' = [a] -> TrieSet a -> TrieSet a
tsinsert [a]
xs TrieSet a
t
              in [(a, TrieSet a)] -> TrieSet a
forall a. [(a, TrieSet a)] -> TrieSet a
TS ([(a, TrieSet a)] -> TrieSet a) -> [(a, TrieSet a)] -> TrieSet a
forall a b. (a -> b) -> a -> b
$ (a, TrieSet a) -> [(a, TrieSet a)] -> [(a, TrieSet a)]
forall a. Ord a => a -> [a] -> [a]
L.insert (a
x,TrieSet a
t') ([(a, TrieSet a)] -> [(a, TrieSet a)])
-> [(a, TrieSet a)] -> [(a, TrieSet a)]
forall a b. (a -> b) -> a -> b
$ (a, TrieSet a) -> [(a, TrieSet a)] -> [(a, TrieSet a)]
forall a. Eq a => a -> [a] -> [a]
L.delete (a
x,TrieSet a
t) [(a, TrieSet a)]
ts
tsinsert [] t :: TrieSet a
t = TrieSet a
t

tsmember :: [a] -> TrieSet a -> Bool
tsmember (x :: a
x:xs :: [a]
xs) (TS ts :: [(a, TrieSet a)]
ts) =
    case a -> [(a, TrieSet a)] -> Maybe (TrieSet a)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x [(a, TrieSet a)]
ts of
    Nothing -> Bool
False
    Just t :: TrieSet a
t -> [a] -> TrieSet a -> Bool
tsmember [a]
xs TrieSet a
t
tsmember [] (TS []) = Bool
True -- the node has no children, and hence is terminal
tsmember [] _ = Bool
False

-- xs is a subset of a member of t
tssubmember :: [a] -> TrieSet a -> Bool
tssubmember (x :: a
x:xs :: [a]
xs) (TS ts :: [(a, TrieSet a)]
ts) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
                                  LT -> Bool
False
                                  EQ -> [a] -> TrieSet a -> Bool
tssubmember [a]
xs TrieSet a
t
                                  GT -> [a] -> TrieSet a -> Bool
tssubmember (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) TrieSet a
t
                                | (y :: a
y,t :: TrieSet a
t) <- [(a, TrieSet a)]
ts ]
tssubmember [] _ = Bool
True

tstolist :: TrieSet a -> [[a]]
tstolist (TS []) = [[]]
tstolist (TS xts :: [(a, TrieSet a)]
xts) = ((a, TrieSet a) -> [[a]]) -> [(a, TrieSet a)] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(x :: a
x,t :: TrieSet a
t) -> ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (TrieSet a -> [[a]]
tstolist TrieSet a
t)) [(a, TrieSet a)]
xts 

tsfromlist :: t [a] -> TrieSet a
tsfromlist = (TrieSet a -> [a] -> TrieSet a) -> TrieSet a -> t [a] -> TrieSet a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([a] -> TrieSet a -> TrieSet a) -> TrieSet a -> [a] -> TrieSet a
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> TrieSet a -> TrieSet a
forall a. Ord a => [a] -> TrieSet a -> TrieSet a
tsinsert) TrieSet a
forall a. TrieSet a
tsempty


-- |A datatype to represent a matroid. @M es bs@ is the matroid whose elements are @es@, and whose bases are @bs@.
-- The normal form is for the @es@ to be in order, for each of the @bs@ individually to be in order.
-- (So the TrieSet should have the property that any path from the root to a leaf is strictly increasing).
data Matroid a = M [a] (TrieSet a) deriving (Matroid a -> Matroid a -> Bool
(Matroid a -> Matroid a -> Bool)
-> (Matroid a -> Matroid a -> Bool) -> Eq (Matroid a)
forall a. Eq a => Matroid a -> Matroid a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Matroid a -> Matroid a -> Bool
$c/= :: forall a. Eq a => Matroid a -> Matroid a -> Bool
== :: Matroid a -> Matroid a -> Bool
$c== :: forall a. Eq a => Matroid a -> Matroid a -> Bool
Eq,Int -> Matroid a -> [Char] -> [Char]
[Matroid a] -> [Char] -> [Char]
Matroid a -> [Char]
(Int -> Matroid a -> [Char] -> [Char])
-> (Matroid a -> [Char])
-> ([Matroid a] -> [Char] -> [Char])
-> Show (Matroid a)
forall a. Show a => Int -> Matroid a -> [Char] -> [Char]
forall a. Show a => [Matroid a] -> [Char] -> [Char]
forall a. Show a => Matroid a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Matroid a] -> [Char] -> [Char]
$cshowList :: forall a. Show a => [Matroid a] -> [Char] -> [Char]
show :: Matroid a -> [Char]
$cshow :: forall a. Show a => Matroid a -> [Char]
showsPrec :: Int -> Matroid a -> [Char] -> [Char]
$cshowsPrec :: forall a. Show a => Int -> Matroid a -> [Char] -> [Char]
Show,a -> Matroid b -> Matroid a
(a -> b) -> Matroid a -> Matroid b
(forall a b. (a -> b) -> Matroid a -> Matroid b)
-> (forall a b. a -> Matroid b -> Matroid a) -> Functor Matroid
forall a b. a -> Matroid b -> Matroid a
forall a b. (a -> b) -> Matroid a -> Matroid b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Matroid b -> Matroid a
$c<$ :: forall a b. a -> Matroid b -> Matroid a
fmap :: (a -> b) -> Matroid a -> Matroid b
$cfmap :: forall a b. (a -> b) -> Matroid a -> Matroid b
Functor)

-- |Return the elements over which the matroid is defined.
elements :: Matroid t -> [t]
elements :: Matroid t -> [t]
elements (M es :: [t]
es bs :: TrieSet t
bs) = [t]
es

-- |Return all the independent sets of a matroid, in shortlex order.
indeps :: (Ord a) => Matroid a -> [[a]]
indeps :: Matroid a -> [[a]]
indeps m :: Matroid a
m = [([a], [a])] -> [[a]]
bfs [ ([],[a]
es) ]
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
          bfs :: [([a], [a])] -> [[a]]
bfs ( (ls :: [a]
ls,rs :: [a]
rs) : nodes :: [([a], [a])]
nodes ) =
              let ls' :: [a]
ls' = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ls in
              if Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isIndependent Matroid a
m [a]
ls'
              then [a]
ls' [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [([a], [a])] -> [[a]]
bfs ( [([a], [a])]
nodes [([a], [a])] -> [([a], [a])] -> [([a], [a])]
forall a. [a] -> [a] -> [a]
++ ([a], [a]) -> [([a], [a])]
forall a. ([a], [a]) -> [([a], [a])]
successors ([a]
ls,[a]
rs) )
              else [([a], [a])] -> [[a]]
bfs [([a], [a])]
nodes
          bfs [] = []
          successors :: ([a], [a]) -> [([a], [a])]
successors (ls :: [a]
ls,rs :: [a]
rs) = [ (a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls, [a]
rs') | r :: a
r:rs' :: [a]
rs' <- [a] -> [[a]]
forall a. [a] -> [[a]]
L.tails [a]
rs ]

isIndependent :: (Ord a) => Matroid a -> [a] -> Bool
isIndependent :: Matroid a -> [a] -> Bool
isIndependent (M es :: [a]
es bs :: TrieSet a
bs) xs :: [a]
xs = [a]
xs [a] -> TrieSet a -> Bool
forall a. Ord a => [a] -> TrieSet a -> Bool
`tssubmember` TrieSet a
bs

isDependent :: (Ord a) => Matroid a -> [a] -> Bool
isDependent :: Matroid a -> [a] -> Bool
isDependent m :: Matroid a
m = Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isIndependent Matroid a
m

-- |Are these the independent sets of a matroid? (The sets must individually be ordered.)
isMatroidIndeps :: (Ord a) => [[a]] -> Bool
isMatroidIndeps :: [[a]] -> Bool
isMatroidIndeps is :: [[a]]
is =
    [] [a] -> [[a]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[a]]
is Bool -> Bool -> Bool
&&
    [[a]] -> Bool
forall a. Ord a => [[a]] -> Bool
closedUnderSubsets [[a]]
is Bool -> Bool -> Bool
&&
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ (Int
l1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l2) Bool -> Bool -> Bool
`implies` [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
exists [a
e | a
e <- [a]
i2 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
i1, a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
L.insert a
e [a]
i1 [a] -> [[a]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[a]]
is]
        | [a]
i1 <- [[a]]
is, let l1 :: Int
l1 = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
i1, [a]
i2 <- [[a]]
is, let l2 :: Int
l2 = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
i2 ]

-- |Construct a matroid from its elements and its independent sets.
fromIndeps :: (Ord a) => [a] -> [[a]] -> Matroid a
fromIndeps :: [a] -> [[a]] -> Matroid a
fromIndeps es :: [a]
es is :: [[a]]
is = [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases [a]
es [[a]]
bs
    where bs :: [[a]]
bs = [[a]] -> [([a], [a])] -> [[a]]
dfs [] [([],[a]
es)]
          dfs :: [[a]] -> [([a], [a])] -> [[a]]
dfs bs :: [[a]]
bs ( node :: ([a], [a])
node@(ls :: [a]
ls,rs :: [a]
rs) : nodes :: [([a], [a])]
nodes ) =
              let succs :: [([a], [a])]
succs = ([a], [a]) -> [([a], [a])]
successors ([a], [a])
node
              in if [([a], [a])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([a], [a])]
succs then [[a]] -> [([a], [a])] -> [[a]]
dfs ([a]
ls[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
bs) [([a], [a])]
nodes else [[a]] -> [([a], [a])] -> [[a]]
dfs [[a]]
bs ([([a], [a])]
succs [([a], [a])] -> [([a], [a])] -> [([a], [a])]
forall a. [a] -> [a] -> [a]
++ [([a], [a])]
nodes)
          dfs ls :: [[a]]
ls [] = let r :: Int
r = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall a. [a] -> a
last [[a]]
ls -- we know that the first one we found is a true base
                      in ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\b :: [a]
b -> [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r) [[a]]
ls
                      -- we might have had null succs simply because we ran out of vectors to add
          successors :: ([a], [a]) -> [([a], [a])]
successors (ls :: [a]
ls,rs :: [a]
rs) = [ (a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls, [a]
rs') | r :: a
r:rs' :: [a]
rs' <- [a] -> [[a]]
forall a. [a] -> [[a]]
L.tails [a]
rs, (a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls) [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
is' ]
          is' :: Set [a]
is' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList ([[a]] -> Set [a]) -> [[a]] -> Set [a]
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
reverse [[a]]
is

-- this seems to be just slightly slower
fromIndeps1 :: [a] -> [[a]] -> Matroid a
fromIndeps1 es :: [a]
es is :: [[a]]
is = [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases [a]
es [[a]]
bs
    where b :: [a]
b = [a] -> [a] -> [a]
greedy [] [a]
es -- first find any basis
          greedy :: [a] -> [a] -> [a]
greedy ls :: [a]
ls (r :: a
r:rs :: [a]
rs) = if (a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls) [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
ris'
                             then [a] -> [a] -> [a]
greedy (a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls) [a]
rs
                             else [a] -> [a] -> [a]
greedy [a]
ls [a]
rs
          greedy ls :: [a]
ls [] = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ls
          ris' :: Set [a]
ris' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList ([[a]] -> Set [a]) -> [[a]] -> Set [a]
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
reverse [[a]]
is
          bs :: [[a]]
bs = Set [a] -> Set [a] -> [[a]]
closure Set [a]
forall a. Set a
S.empty ([a] -> Set [a]
forall a. a -> Set a
S.singleton [a]
b) -- now find all other bases by passing to "neighbouring" bases
          closure :: Set [a] -> Set [a] -> [[a]]
closure interior :: Set [a]
interior boundary :: Set [a]
boundary =
              if Set [a] -> Bool
forall a. Set a -> Bool
S.null Set [a]
boundary
              then Set [a] -> [[a]]
forall a. Set a -> [a]
S.toList Set [a]
interior
              else let interior' :: Set [a]
interior' = Set [a]
interior Set [a] -> Set [a] -> Set [a]
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set [a]
boundary
                       boundary' :: Set [a]
boundary' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [ [a]
b' | [a]
b <- Set [a] -> [[a]]
forall a. Set a -> [a]
S.toList Set [a]
boundary,
                                                     a
x <- [a]
b, a
y <- [a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b,
                                                     let b' :: [a]
b' = a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
L.insert a
y (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
x [a]
b),
                                                     [a]
b' [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set [a]
interior',
                                                     [a]
b' [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
is' ]
                   in Set [a] -> Set [a] -> [[a]]
closure Set [a]
interior' Set [a]
boundary'
          is' :: Set [a]
is' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
is
-- The basis properties imply that the set of all bases is connected under the "neighbour" relation


-- |Given a matrix, represented as a list of rows, number the columns [1..],
-- and construct the matroid whose independent sets correspond to those sets of columns which are linearly independent
-- (or in case there are repetitions, those multisets of columns which are sets, and which are linearly independent).
vectorMatroid :: (Eq k, Fractional k) => [[k]] -> Matroid Int
vectorMatroid :: [[k]] -> Matroid Int
vectorMatroid = [[k]] -> Matroid Int
forall k. (Eq k, Fractional k) => [[k]] -> Matroid Int
vectorMatroid' ([[k]] -> Matroid Int) -> ([[k]] -> [[k]]) -> [[k]] -> Matroid Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[k]] -> [[k]]
forall a. [[a]] -> [[a]]
L.transpose

-- |Given a list of vectors (or rows of a matrix), number the vectors (rows) [1..], and construct the matroid whose independent sets
-- correspond to those sets of vectors (rows) which are linearly independent
-- (or in case there are repetitions, those multisets which are sets, and which are linearly independent).
vectorMatroid' :: (Eq k, Fractional k) => [[k]] -> Matroid Int
vectorMatroid' :: [[k]] -> Matroid Int
vectorMatroid' vs :: [[k]]
vs = [Int] -> [[Int]] -> Matroid Int
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases (((Int, [k]) -> Int) -> [(Int, [k])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [k]) -> Int
forall a b. (a, b) -> a
fst [(Int, [k])]
forall a. (Num a, Enum a) => [(a, [k])]
vs') [[Int]]
forall a. (Enum a, Num a) => [[a]]
bs
    where vs' :: [(a, [k])]
vs' = [a] -> [[k]] -> [(a, [k])]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] [[k]]
vs
          bs :: [[a]]
bs = [[a]] -> [([a], [[k]], [(a, [k])])] -> [[a]]
forall a a.
(Eq a, Fractional a) =>
[[a]] -> [([a], [[a]], [(a, [a])])] -> [[a]]
dfs [] [([],[],[(a, [k])]
forall a. (Num a, Enum a) => [(a, [k])]
vs')]
          dfs :: [[a]] -> [([a], [[a]], [(a, [a])])] -> [[a]]
dfs ls :: [[a]]
ls (r :: ([a], [[a]], [(a, [a])])
r@(i :: [a]
i,ref :: [[a]]
ref,es :: [(a, [a])]
es) : rs :: [([a], [[a]], [(a, [a])])]
rs) =
              let succs :: [([a], [[a]], [(a, [a])])]
succs = ([a], [[a]], [(a, [a])]) -> [([a], [[a]], [(a, [a])])]
forall a a.
(Eq a, Fractional a) =>
([a], [[a]], [(a, [a])]) -> [([a], [[a]], [(a, [a])])]
successors ([a], [[a]], [(a, [a])])
r in
              if [([a], [[a]], [(a, [a])])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([a], [[a]], [(a, [a])])]
succs then [[a]] -> [([a], [[a]], [(a, [a])])] -> [[a]]
dfs ([a]
i[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ls) ([([a], [[a]], [(a, [a])])]
succs [([a], [[a]], [(a, [a])])]
-> [([a], [[a]], [(a, [a])])] -> [([a], [[a]], [(a, [a])])]
forall a. [a] -> [a] -> [a]
++ [([a], [[a]], [(a, [a])])]
rs) else [[a]] -> [([a], [[a]], [(a, [a])])] -> [[a]]
dfs [[a]]
ls ([([a], [[a]], [(a, [a])])]
succs [([a], [[a]], [(a, [a])])]
-> [([a], [[a]], [(a, [a])])] -> [([a], [[a]], [(a, [a])])]
forall a. [a] -> [a] -> [a]
++ [([a], [[a]], [(a, [a])])]
rs)
          dfs ls :: [[a]]
ls [] = let r :: Int
r = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall a. [a] -> a
last [[a]]
ls -- we know that the first one we found is a true base
                      in ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\b :: [a]
b -> [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r) [[a]]
ls
                      -- we might have had null succs simply because we ran out of vectors to add
          successors :: ([a], [[a]], [(a, [a])]) -> [([a], [[a]], [(a, [a])])]
successors (i :: [a]
i,ref :: [[a]]
ref,es :: [(a, [a])]
es) = [([a]
i',[[a]]
ref',[(a, [a])]
es') | (j :: a
j,e :: [a]
e):es' :: [(a, [a])]
es' <- [(a, [a])] -> [[(a, [a])]]
forall a. [a] -> [[a]]
L.tails [(a, [a])]
es,
                                                   Bool -> Bool
not ([[a]] -> [a] -> Bool
forall a. (Eq a, Num a) => [[a]] -> [a] -> Bool
inSpanRE [[a]]
ref [a]
e),
                                                   let ref' :: [[a]]
ref' = [[a]] -> [[a]]
forall a. (Eq a, Fractional a) => [[a]] -> [[a]]
rowEchelonForm ([[a]]
ref [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]
e]), -- is this really better than e:ref?
                                                   let i' :: [a]
i' = a
j a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
i ]

-- |Given the edges of an undirected graph, number the edges [1..], and construct the matroid whose independent sets
-- correspond to those sets of edges which contain no cycle. The bases therefore correspond to maximal forests within the graph.
-- The edge set is allowed to contain loops or parallel edges.
cycleMatroid :: (Ord a) => [[a]] -> Matroid Int
cycleMatroid :: [[a]] -> Matroid Int
cycleMatroid es :: [[a]]
es = [Int] -> [[Int]] -> Matroid Int
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases (((Int, [a]) -> Int) -> [(Int, [a])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [a]) -> Int
forall a b. (a, b) -> a
fst [(Int, [a])]
forall a. (Num a, Enum a) => [(a, [a])]
es') [[Int]]
forall a. (Num a, Enum a) => [[a]]
bs
    where es' :: [(a, [a])]
es' = [a] -> [[a]] -> [(a, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] [[a]]
es
          bs :: [[a]]
bs = [[a]] -> [([a], Map a a, [(a, [a])])] -> [[a]]
forall k a. Ord k => [[a]] -> [([a], Map k k, [(a, [k])])] -> [[a]]
dfs [] [([], Map a a
forall k a. Map k a
M.empty, [(a, [a])]
forall a. (Num a, Enum a) => [(a, [a])]
es')]
          dfs :: [[a]] -> [([a], Map k k, [(a, [k])])] -> [[a]]
dfs ls :: [[a]]
ls (r :: ([a], Map k k, [(a, [k])])
r@(i :: [a]
i,ref :: Map k k
ref,es :: [(a, [k])]
es) : rs :: [([a], Map k k, [(a, [k])])]
rs) =
              let succs :: [([a], Map k k, [(a, [k])])]
succs = ([a], Map k k, [(a, [k])]) -> [([a], Map k k, [(a, [k])])]
forall k a.
Ord k =>
([a], Map k k, [(a, [k])]) -> [([a], Map k k, [(a, [k])])]
successors ([a], Map k k, [(a, [k])])
r
              in if [([a], Map k k, [(a, [k])])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([a], Map k k, [(a, [k])])]
succs then [[a]] -> [([a], Map k k, [(a, [k])])] -> [[a]]
dfs ([a]
i[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ls) ([([a], Map k k, [(a, [k])])]
succs [([a], Map k k, [(a, [k])])]
-> [([a], Map k k, [(a, [k])])] -> [([a], Map k k, [(a, [k])])]
forall a. [a] -> [a] -> [a]
++ [([a], Map k k, [(a, [k])])]
rs) else [[a]] -> [([a], Map k k, [(a, [k])])] -> [[a]]
dfs [[a]]
ls ([([a], Map k k, [(a, [k])])]
succs [([a], Map k k, [(a, [k])])]
-> [([a], Map k k, [(a, [k])])] -> [([a], Map k k, [(a, [k])])]
forall a. [a] -> [a] -> [a]
++ [([a], Map k k, [(a, [k])])]
rs)
          dfs ls :: [[a]]
ls [] = let r :: Int
r = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall a. [a] -> a
last [[a]]
ls -- we know that the first one we found is a true base
                      in ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\b :: [a]
b -> [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r) [[a]]
ls
                      -- we might have had null succs simply because we ran out of edges to add
          successors :: ([a], Map k k, [(a, [k])]) -> [([a], Map k k, [(a, [k])])]
successors (i :: [a]
i, reps :: Map k k
reps, (j :: a
j,[u :: k
u,v :: k
v]):es' :: [(a, [k])]
es' ) =
              if k
u k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
v
              then ([a], Map k k, [(a, [k])]) -> [([a], Map k k, [(a, [k])])]
successors ([a]
i, Map k k
reps, [(a, [k])]
es')
              else case (k -> Map k k -> Maybe k
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
u Map k k
reps, k -> Map k k -> Maybe k
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
v Map k k
reps) of
                   (Nothing, Nothing) -> (a
ja -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
i, k -> k -> Map k k -> Map k k
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
u k
u (Map k k -> Map k k) -> Map k k -> Map k k
forall a b. (a -> b) -> a -> b
$ k -> k -> Map k k -> Map k k
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
v k
u Map k k
reps, [(a, [k])]
es') ([a], Map k k, [(a, [k])])
-> [([a], Map k k, [(a, [k])])] -> [([a], Map k k, [(a, [k])])]
forall a. a -> [a] -> [a]
: ([a], Map k k, [(a, [k])]) -> [([a], Map k k, [(a, [k])])]
successors ([a]
i, Map k k
reps, [(a, [k])]
es')
                                         -- neither of these vertices has been seen before, so add this edge as a new tree in the forest
                   (Just u' :: k
u', Nothing) -> (a
ja -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
i, k -> k -> Map k k -> Map k k
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
v k
u' Map k k
reps, [(a, [k])]
es') ([a], Map k k, [(a, [k])])
-> [([a], Map k k, [(a, [k])])] -> [([a], Map k k, [(a, [k])])]
forall a. a -> [a] -> [a]
: ([a], Map k k, [(a, [k])]) -> [([a], Map k k, [(a, [k])])]
successors ([a]
i, Map k k
reps, [(a, [k])]
es')
                                         -- we have seen u before but not v, so add v to the u-tree
                   (Nothing, Just v' :: k
v') -> (a
ja -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
i, k -> k -> Map k k -> Map k k
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
u k
v' Map k k
reps, [(a, [k])]
es') ([a], Map k k, [(a, [k])])
-> [([a], Map k k, [(a, [k])])] -> [([a], Map k k, [(a, [k])])]
forall a. a -> [a] -> [a]
: ([a], Map k k, [(a, [k])]) -> [([a], Map k k, [(a, [k])])]
successors ([a]
i, Map k k
reps, [(a, [k])]
es')
                                         -- we have seen v before but not u, so add u to the v-tree
                   (Just u' :: k
u', Just v' :: k
v') -> if k
u' k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
v'
                                         then ([a], Map k k, [(a, [k])]) -> [([a], Map k k, [(a, [k])])]
successors ([a]
i,Map k k
reps,[(a, [k])]
es')
                                              -- u and v are already in the same tree, so adding this edge would make a cycle
                                         else (a
ja -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
i, (k -> k) -> Map k k -> Map k k
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\w :: k
w -> if k
w k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
v' then k
u' else k
w) Map k k
reps, [(a, [k])]
es') ([a], Map k k, [(a, [k])])
-> [([a], Map k k, [(a, [k])])] -> [([a], Map k k, [(a, [k])])]
forall a. a -> [a] -> [a]
: ([a], Map k k, [(a, [k])]) -> [([a], Map k k, [(a, [k])])]
successors ([a]
i, Map k k
reps, [(a, [k])]
es')
                                              -- u and v are in different trees, so join the trees together
          successors (_, _, []) = []

-- A version of cycle matroid that retains the original edges rather than relabeling with integers.
-- Not really valid if there are parallel edges (because they can't be distinguished in the output).
-- Required for "markedfcim" below.
cycleMatroid' :: [[a]] -> Matroid [a]
cycleMatroid' es :: [[a]]
es = (Int -> [a]) -> Matroid Int -> Matroid [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> [a]
forall k. (Ord k, Num k, Enum k) => k -> [a]
lookupEdge (Matroid Int -> Matroid [a]) -> Matroid Int -> Matroid [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> Matroid Int
forall a. Ord a => [[a]] -> Matroid Int
cycleMatroid [[a]]
es
    where table :: Map k [a]
table = [(k, [a])] -> Map k [a]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, [a])] -> Map k [a]) -> [(k, [a])] -> Map k [a]
forall a b. (a -> b) -> a -> b
$ [k] -> [[a]] -> [(k, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] [[a]]
es
          lookupEdge :: k -> [a]
lookupEdge = Map k [a] -> k -> [a]
forall k a. Ord k => Map k a -> k -> a
(M.!) Map k [a]
forall k. (Ord k, Num k, Enum k) => Map k [a]
table


-- |Given a matroid over an arbitrary type, relabel to obtain a matroid over the integers.
to1n :: (Ord a) => Matroid a -> Matroid Int
to1n :: Matroid a -> Matroid Int
to1n m :: Matroid a
m = (a -> Int) -> Matroid a -> Matroid Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Int
forall a. (Num a, Enum a) => a -> a
to1n' Matroid a
m
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
          table :: Map a a
table = [(a, a)] -> Map a a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, a)] -> Map a a) -> [(a, a)] -> Map a a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
es [1..]
          to1n' :: a -> a
to1n' = Map a a -> a -> a
forall k a. Ord k => Map k a -> k -> a
(M.!) Map a a
forall a. (Num a, Enum a) => Map a a
table


-- ISOMORPHISMS AND AUTOMORPHISMS

incidenceGraphB :: Matroid t -> Graph (Either t [t])
incidenceGraphB m :: Matroid t
m = [Either t [t]] -> [[Either t [t]]] -> Graph (Either t [t])
forall a. [a] -> [[a]] -> Graph a
G.G [Either t [t]]
vs' [[Either t [t]]]
es'
    where es :: [t]
es = Matroid t -> [t]
forall t. Matroid t -> [t]
elements Matroid t
m
          bs :: [[t]]
bs = Matroid t -> [[t]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid t
m
          vs' :: [Either t [t]]
vs' = (t -> Either t [t]) -> [t] -> [Either t [t]]
forall a b. (a -> b) -> [a] -> [b]
map t -> Either t [t]
forall a b. a -> Either a b
Left [t]
es [Either t [t]] -> [Either t [t]] -> [Either t [t]]
forall a. [a] -> [a] -> [a]
++ ([t] -> Either t [t]) -> [[t]] -> [Either t [t]]
forall a b. (a -> b) -> [a] -> [b]
map [t] -> Either t [t]
forall a b. b -> Either a b
Right [[t]]
bs
          es' :: [[Either t [t]]]
es' = [[Either t [t]]] -> [[Either t [t]]]
forall a. Ord a => [a] -> [a]
L.sort [ [t -> Either t [t]
forall a b. a -> Either a b
Left t
e, [t] -> Either t [t]
forall a b. b -> Either a b
Right [t]
b] | [t]
b <- [[t]]
bs, t
e <- [t]
b ]
-- incidence graph for the matroid considered as an incidence structure between elements and bases

incidenceGraphC :: Matroid t -> Graph (Either t [t])
incidenceGraphC m :: Matroid t
m = [Either t [t]] -> [[Either t [t]]] -> Graph (Either t [t])
forall a. [a] -> [[a]] -> Graph a
G.G [Either t [t]]
vs' [[Either t [t]]]
es'
    where es :: [t]
es = Matroid t -> [t]
forall t. Matroid t -> [t]
elements Matroid t
m
          cs :: [[t]]
cs = [[t]] -> [[t]]
forall a. Ord a => [a] -> [a]
L.sort ([[t]] -> [[t]]) -> [[t]] -> [[t]]
forall a b. (a -> b) -> a -> b
$ Matroid t -> [[t]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid t
m
          vs' :: [Either t [t]]
vs' = (t -> Either t [t]) -> [t] -> [Either t [t]]
forall a b. (a -> b) -> [a] -> [b]
map t -> Either t [t]
forall a b. a -> Either a b
Left [t]
es [Either t [t]] -> [Either t [t]] -> [Either t [t]]
forall a. [a] -> [a] -> [a]
++ ([t] -> Either t [t]) -> [[t]] -> [Either t [t]]
forall a b. (a -> b) -> [a] -> [b]
map [t] -> Either t [t]
forall a b. b -> Either a b
Right [[t]]
cs
          es' :: [[Either t [t]]]
es' = [[Either t [t]]] -> [[Either t [t]]]
forall a. Ord a => [a] -> [a]
L.sort [ [t -> Either t [t]
forall a b. a -> Either a b
Left t
e, [t] -> Either t [t]
forall a b. b -> Either a b
Right [t]
c] | [t]
c <- [[t]]
cs, t
e <- [t]
c ]
-- incidence graph for the matroid considered as an incidence structure between elements and circuits

incidenceGraphH :: Matroid t -> Graph (Either t [t])
incidenceGraphH m :: Matroid t
m = [Either t [t]] -> [[Either t [t]]] -> Graph (Either t [t])
forall a. [a] -> [[a]] -> Graph a
G.G [Either t [t]]
vs' [[Either t [t]]]
es'
    where es :: [t]
es = Matroid t -> [t]
forall t. Matroid t -> [t]
elements Matroid t
m
          hs :: [[t]]
hs = [[t]] -> [[t]]
forall a. Ord a => [a] -> [a]
L.sort ([[t]] -> [[t]]) -> [[t]] -> [[t]]
forall a b. (a -> b) -> a -> b
$ Matroid t -> [[t]]
forall a. Ord a => Matroid a -> [[a]]
hyperplanes Matroid t
m
          vs' :: [Either t [t]]
vs' = (t -> Either t [t]) -> [t] -> [Either t [t]]
forall a b. (a -> b) -> [a] -> [b]
map t -> Either t [t]
forall a b. a -> Either a b
Left [t]
es [Either t [t]] -> [Either t [t]] -> [Either t [t]]
forall a. [a] -> [a] -> [a]
++ ([t] -> Either t [t]) -> [[t]] -> [Either t [t]]
forall a b. (a -> b) -> [a] -> [b]
map [t] -> Either t [t]
forall a b. b -> Either a b
Right [[t]]
hs
          es' :: [[Either t [t]]]
es' = [[Either t [t]]] -> [[Either t [t]]]
forall a. Ord a => [a] -> [a]
L.sort [ [t -> Either t [t]
forall a b. a -> Either a b
Left t
e, [t] -> Either t [t]
forall a b. b -> Either a b
Right [t]
h] | [t]
h <- [[t]]
hs, t
e <- [t]
h ]
-- incidence graph for the matroid considered as an incidence structure between elements and hyperplanes
-- for "sparse" matroids, there are likely to be fewer hyperplanes than bases (why?)
-- incidenceGraphH may not be connected - eg u 2 4

-- (So a rank 3 or higher matroid, provided it has more than one hyperplane, certainly has a connected incidenceGraphH)

matroidIsos :: Matroid a -> Matroid b2 -> [[(a, b2)]]
matroidIsos m1 :: Matroid a
m1 m2 :: Matroid b2
m2 = Graph (Either a [a]) -> Graph (Either b2 [b2]) -> [[(a, b2)]]
forall a b1 b2 b3.
(Ord b2, Ord b3, Ord a, Ord b1) =>
Graph (Either a b1) -> Graph (Either b2 b3) -> [[(a, b2)]]
incidenceIsos (Matroid a -> Graph (Either a [a])
forall t. Ord t => Matroid t -> Graph (Either t [t])
incidenceGraphH Matroid a
m1) (Matroid b2 -> Graph (Either b2 [b2])
forall t. Ord t => Matroid t -> Graph (Either t [t])
incidenceGraphH Matroid b2
m2)

-- |Are the two matroids isomorphic?
isMatroidIso :: (Ord a, Ord b) => Matroid a -> Matroid b -> Bool
isMatroidIso :: Matroid a -> Matroid b -> Bool
isMatroidIso m1 :: Matroid a
m1 m2 :: Matroid b
m2 = Graph (Either a [a]) -> Graph (Either b [b]) -> Bool
forall p1 b1 p2 b2.
(Ord p1, Ord b1, Ord p2, Ord b2) =>
Graph (Either p1 b1) -> Graph (Either p2 b2) -> Bool
isIncidenceIso (Matroid a -> Graph (Either a [a])
forall t. Ord t => Matroid t -> Graph (Either t [t])
incidenceGraphH Matroid a
m1) (Matroid b -> Graph (Either b [b])
forall t. Ord t => Matroid t -> Graph (Either t [t])
incidenceGraphH Matroid b
m2)

-- |Return the automorphisms of the matroid.
matroidAuts :: (Ord a) => Matroid a -> [Permutation a]
matroidAuts :: Matroid a -> [Permutation a]
matroidAuts m :: Matroid a
m = Graph (Either a [a]) -> [Permutation a]
forall p b. (Ord p, Ord b) => Graph (Either p b) -> [Permutation p]
incidenceAuts (Graph (Either a [a]) -> [Permutation a])
-> Graph (Either a [a]) -> [Permutation a]
forall a b. (a -> b) -> a -> b
$ Matroid a -> Graph (Either a [a])
forall t. Ord t => Matroid t -> Graph (Either t [t])
incidenceGraphH Matroid a
m
-- Note that the results aren't always what one intuitively expects from the geometric representation.
-- This is because geometric representations suggest additional structure beyond matroid structure.
-- For example, for the Vamos matroid v8,
-- it returns auts which are not "geometric" auts of the geometric representation.
-- Matroids are really combinatorial objects, not geometric.
-- In the case of v8, the key is that the only thing the auts have to preserve are the planes, not the lines


-- CIRCUITS

-- |A circuit in a matroid is a minimal dependent set.
isCircuit :: (Ord a) => Matroid a -> [a] -> Bool
isCircuit :: Matroid a -> [a] -> Bool
isCircuit m :: Matroid a
m c :: [a]
c =
    Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isDependent Matroid a
m [a]
c Bool -> Bool -> Bool
&&
    ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isIndependent Matroid a
m) ([a] -> [[a]]
forall a. [a] -> [[a]]
deletions [a]
c)

-- |Return all circuits for the given matroid, in shortlex order.
circuits :: (Ord a) => Matroid a -> [[a]]
circuits :: Matroid a -> [[a]]
circuits m :: Matroid a
m = [[a]] -> [[a]]
forall (t :: * -> *) a. (Ord (t a), Foldable t) => [t a] -> [t a]
toShortlex ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ Set [a] -> [[a]] -> [[a]]
dfs Set [a]
forall a. Set a
S.empty [a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
L.insert a
e [a]
b | [a]
b <- [[a]]
bs, a
e <- [a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b]
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
          bs :: [[a]]
bs = Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid a
m
          dfs :: Set [a] -> [[a]] -> [[a]]
dfs vs :: Set [a]
vs (c :: [a]
c:cs :: [[a]]
cs) | [a]
c [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
vs = Set [a] -> [[a]] -> [[a]]
dfs Set [a]
vs [[a]]
cs
                        | Bool
otherwise = let cs' :: [[a]]
cs' = [a] -> [[a]]
successors [a]
c
                                          vs' :: Set [a]
vs' = [a] -> Set [a] -> Set [a]
forall a. Ord a => a -> Set a -> Set a
S.insert [a]
c Set [a]
vs
                                      in if [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
cs' then [a]
c [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Set [a] -> [[a]] -> [[a]]
dfs Set [a]
vs' [[a]]
cs else Set [a] -> [[a]] -> [[a]]
dfs Set [a]
vs' ([[a]]
cs' [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
cs)
          dfs _ [] = []
          successors :: [a] -> [[a]]
successors c :: [a]
c = [[a]
c' | [a]
c' <- [a] -> [[a]]
forall a. [a] -> [[a]]
deletions [a]
c, Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isDependent Matroid a
m [a]
c' ]

-- Oxley p10
-- |Are the given sets the circuits of some matroid?
isMatroidCircuits :: (Ord a) => [[a]] -> Bool
isMatroidCircuits :: [[a]] -> Bool
isMatroidCircuits cs :: [[a]]
cs =
    [] [a] -> [[a]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[a]]
cs Bool -> Bool -> Bool
&&
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [([a]
c1 [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`LS.isSubset` [a]
c2) Bool -> Bool -> Bool
`implies` ([a]
c1 [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
c2) | [a]
c1 <- [[a]]
cs, [a]
c2 <- [[a]]
cs] Bool -> Bool -> Bool
&&
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
exists [[a]
c3 | [a]
c3 <- [[a]]
cs, [a]
c3 [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`LS.isSubset` [a]
c12']
        | [a]
c1 <- [[a]]
cs, [a]
c2 <- [[a]]
cs, [a]
c1 [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
/= [a]
c2,
          a
e <- [a]
c1 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`LS.intersect` [a]
c2, let c12' :: [a]
c12' = a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
e ([a]
c1 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`LS.union` [a]
c2)] 

-- |Reconstruct a matroid from its elements and circuits.
fromCircuits :: (Ord a) => [a] -> [[a]] -> Matroid a
fromCircuits :: [a] -> [[a]] -> Matroid a
fromCircuits es :: [a]
es cs :: [[a]]
cs = [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases [a]
es [[a]]
bs
    where b :: [a]
b = [a] -> [a] -> [a]
greedy [] [a]
es -- first find any basis
          greedy :: [a] -> [a] -> [a]
greedy ls :: [a]
ls (r :: a
r:rs :: [a]
rs) = let ls' :: [a]
ls' = [a]
ls [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
r] in
                             if [a] -> Bool
isIndep [a]
ls'
                             then [a] -> [a] -> [a]
greedy [a]
ls' [a]
rs
                             else [a] -> [a] -> [a]
greedy [a]
ls [a]
rs
          greedy ls :: [a]
ls [] = [a]
ls
          bs :: [[a]]
bs = Set [a] -> Set [a] -> [[a]]
closure Set [a]
forall a. Set a
S.empty ([a] -> Set [a]
forall a. a -> Set a
S.singleton [a]
b) -- now find all other bases by passing to "neighbouring" bases
          closure :: Set [a] -> Set [a] -> [[a]]
closure interior :: Set [a]
interior boundary :: Set [a]
boundary =
              if Set [a] -> Bool
forall a. Set a -> Bool
S.null Set [a]
boundary
              then Set [a] -> [[a]]
forall a. Set a -> [a]
S.toList Set [a]
interior
              else let interior' :: Set [a]
interior' = Set [a]
interior Set [a] -> Set [a] -> Set [a]
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set [a]
boundary
                       boundary' :: Set [a]
boundary' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [ [a]
b' | [a]
b <- Set [a] -> [[a]]
forall a. Set a -> [a]
S.toList Set [a]
boundary,
                                                     a
x <- [a]
b, a
y <- [a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b,
                                                     let b' :: [a]
b' = a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
L.insert a
y (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
x [a]
b),
                                                     [a]
b' [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set [a]
interior',
                                                     [a] -> Bool
isIndep [a]
b' ]
                   in Set [a] -> Set [a] -> [[a]]
closure Set [a]
interior' Set [a]
boundary'
          isIndep :: [a] -> Bool
isIndep xs :: [a]
xs = Bool -> Bool
not (([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`LS.isSubset` [a]
xs) [[a]]
cs)


-- |An element e in a matroid M is a loop if {e} is a circuit of M.
isLoop :: (Ord a) => Matroid a -> a -> Bool
isLoop :: Matroid a -> a -> Bool
isLoop m :: Matroid a
m e :: a
e = Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isCircuit Matroid a
m [a
e]
-- isLoop (M es is) e = [e] `notElem` is

-- |Elements f and g in a matroid M are parallel if {f,g} is a circuit of M.
isParallel :: (Ord a) => Matroid a -> a -> a -> Bool
isParallel :: Matroid a -> a -> a -> Bool
isParallel m :: Matroid a
m f :: a
f g :: a
g = Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isCircuit Matroid a
m [a
f,a
g]

-- |A matroid is simple if it has no loops or parallel elements
isSimple :: (Ord a) => Matroid a -> Bool
isSimple :: Matroid a -> Bool
isSimple m :: Matroid a
m = ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>2) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ) (Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m)


-- BASES

-- |A base or basis in a matroid is a maximal independent set.
isBase :: (Ord a) => Matroid a -> [a] -> Bool
isBase :: Matroid a -> [a] -> Bool
isBase (M es :: [a]
es bs :: TrieSet a
bs) b :: [a]
b = [a]
b [a] -> TrieSet a -> Bool
forall a. Eq a => [a] -> TrieSet a -> Bool
`tsmember` TrieSet a
bs

-- |Return all bases for the given matroid
bases :: (Ord a) => Matroid a -> [[a]]
bases :: Matroid a -> [[a]]
bases (M es :: [a]
es bs :: TrieSet a
bs) = TrieSet a -> [[a]]
forall a. TrieSet a -> [[a]]
tstolist TrieSet a
bs

-- |Are the given sets the bases of some matroid?
isMatroidBases :: (Ord a) => [[a]] -> Bool
isMatroidBases :: [[a]] -> Bool
isMatroidBases bs :: [[a]]
bs =
    (Bool -> Bool
not (Bool -> Bool) -> ([[a]] -> Bool) -> [[a]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[a]]
bs Bool -> Bool -> Bool
&&
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
exists [a
y | a
y <- [a]
b2 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b1, a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
L.insert a
y (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
x [a]
b1) [a] -> [[a]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[a]]
bs]
        | [a]
b1 <- [[a]]
bs, [a]
b2 <- [[a]]
bs, a
x <- [a]
b1 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b2 ]

-- |Reconstruct a matroid from its elements and bases.
fromBases :: (Ord a) => [a] -> [[a]] -> Matroid a
fromBases :: [a] -> [[a]] -> Matroid a
fromBases es :: [a]
es bs :: [[a]]
bs = [a] -> TrieSet a -> Matroid a
forall a. [a] -> TrieSet a -> Matroid a
M [a]
es ([[a]] -> TrieSet a
forall (t :: * -> *) a. (Foldable t, Ord a) => t [a] -> TrieSet a
tsfromlist [[a]]
bs)
-- The elements are required because a loop does not appear in any basis.

-- Oxley p17
-- |Given a matroid m, a basis b, and an element e, @fundamentalCircuit m b e@ returns the unique circuit contained in b union {e},
-- which is called the fundamental circuit of e with respect to b.
fundamentalCircuit :: (Ord a) => Matroid a -> [a] -> a -> [a]
fundamentalCircuit :: Matroid a -> [a] -> a -> [a]
fundamentalCircuit m :: Matroid a
m b :: [a]
b e :: a
e = [[a]] -> [a]
forall a. [a] -> a
unique [[a]
c | [a]
c <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m, [a]
c [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`LS.isSubset` [a]
be]
    where be :: [a]
be = a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
L.insert a
e [a]
b

uniformMatroid :: Int -> Int -> Matroid Int
uniformMatroid m :: Int
m n :: Int
n | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = [Int] -> [[Int]] -> Matroid Int
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases [Int]
es [[Int]]
bs
    where es :: [Int]
es = [1..Int
n]
          bs :: [[Int]]
bs = Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
m [Int]
es

-- |The uniform matroid U m n is the matroid whose independent sets are all subsets of [1..n] with m or fewer elements.
u :: Int -> Int -> Matroid Int
u :: Int -> Int -> Matroid Int
u = Int -> Int -> Matroid Int
uniformMatroid


-- RANK FUNCTION

-- Oxley p103, 3.1.14
restriction1 :: Matroid a -> [a] -> Matroid a
restriction1 m :: Matroid a
m xs :: [a]
xs = [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases [a]
xs [[a]]
bs'
    where bs :: [[a]]
bs = Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid a
m
          is' :: [[a]]
is' = [[a]] -> [[a]]
forall (t :: * -> *) a. (Ord (t a), Foldable t) => [t a] -> [t a]
toShortlex [[a]
b [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`LS.intersect` [a]
xs | [a]
b <- [[a]]
bs]
          r :: Int
r = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall a. [a] -> a
last [[a]]
is'
          bs' :: [[a]]
bs' = ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ( (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
r) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ) [[a]]
is'

-- |The restriction of a matroid to a subset of its elements
restriction :: (Ord a) => Matroid a -> [a] -> Matroid a
restriction :: Matroid a -> [a] -> Matroid a
restriction m :: Matroid a
m@(M es :: [a]
es bs :: TrieSet a
bs) xs :: [a]
xs = [a] -> TrieSet a -> Matroid a
forall a. [a] -> TrieSet a -> Matroid a
M [a]
xs TrieSet a
bs'
    where (_,bs' :: TrieSet a
bs') = TrieSet a -> (Integer, TrieSet a)
forall a a. (Ord a, Ord a, Num a) => TrieSet a -> (a, TrieSet a)
balance (TrieSet a -> (Integer, TrieSet a))
-> TrieSet a -> (Integer, TrieSet a)
forall a b. (a -> b) -> a -> b
$ TrieSet a -> TrieSet a
prune TrieSet a
bs
          prune :: TrieSet a -> TrieSet a
prune (TS yts :: [(a, TrieSet a)]
yts) = let (ins :: [(a, TrieSet a)]
ins, outs :: [(a, TrieSet a)]
outs) = ((a, TrieSet a) -> Bool)
-> [(a, TrieSet a)] -> ([(a, TrieSet a)], [(a, TrieSet a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (\(y :: a
y,t :: TrieSet a
t) -> a
y a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
xs) [(a, TrieSet a)]
yts
                               ins' :: [(a, TrieSet a)]
ins' = [(a
y, TrieSet a -> TrieSet a
prune TrieSet a
t) | (y :: a
y,t :: TrieSet a
t) <- [(a, TrieSet a)]
ins]
                               outs' :: [(a, TrieSet a)]
outs' = [[(a, TrieSet a)]] -> [(a, TrieSet a)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [(a, TrieSet a)]
zts | (y :: a
y,t :: TrieSet a
t) <- [(a, TrieSet a)]
outs, let TS zts :: [(a, TrieSet a)]
zts = TrieSet a -> TrieSet a
prune TrieSet a
t ]
                           in [(a, TrieSet a)] -> TrieSet a
forall a. [(a, TrieSet a)] -> TrieSet a
TS ([(a, TrieSet a)] -> TrieSet a) -> [(a, TrieSet a)] -> TrieSet a
forall a b. (a -> b) -> a -> b
$ [(a, TrieSet a)]
ins' [(a, TrieSet a)] -> [(a, TrieSet a)] -> [(a, TrieSet a)]
forall a. [a] -> [a] -> [a]
++ [(a, TrieSet a)]
outs'
          balance :: TrieSet a -> (a, TrieSet a)
balance (TS yts :: [(a, TrieSet a)]
yts) = let dyt's :: [(a, (a, TrieSet a))]
dyt's = [(a
d',(a
y,TrieSet a
t')) | (y :: a
y,t :: TrieSet a
t) <- [(a, TrieSet a)]
yts, let (d' :: a
d',t' :: TrieSet a
t') = TrieSet a -> (a, TrieSet a)
balance TrieSet a
t]
                                 d :: a
d = [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ 0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((a, (a, TrieSet a)) -> a) -> [(a, (a, TrieSet a))] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, (a, TrieSet a)) -> a
forall a b. (a, b) -> a
fst [(a, (a, TrieSet a))]
dyt's
                             in (a
da -> a -> a
forall a. Num a => a -> a -> a
+1, [(a, TrieSet a)] -> TrieSet a
forall a. [(a, TrieSet a)] -> TrieSet a
TS ([(a, TrieSet a)] -> TrieSet a) -> [(a, TrieSet a)] -> TrieSet a
forall a b. (a -> b) -> a -> b
$ [(a, TrieSet a)] -> [(a, TrieSet a)]
forall a. Ord a => [a] -> [a]
toSet [(a
y,TrieSet a
t') | (d' :: a
d',(y :: a
y,t' :: TrieSet a
t')) <- [(a, (a, TrieSet a))]
dyt's, a
d' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
d])
-- we have to make the toSet call *after* we balance, otherwise two trees may appear unequal because of undergrowth that is going to be removed

-- !! Need thorough testing to prove that restriction == restriction1


-- |Given a matroid m, @rankfun m@ is the rank function on subsets of its element set
rankfun :: (Ord a) => Matroid a -> [a] -> Int
rankfun :: Matroid a -> [a] -> Int
rankfun m :: Matroid a
m xs :: [a]
xs = ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> (Matroid a -> [a]) -> Matroid a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. [a] -> a
head ([[a]] -> [a]) -> (Matroid a -> [[a]]) -> Matroid a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
bases) (Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
restriction Matroid a
m [a]
xs)
-- no danger of head [], because bases must be non-null

-- |The rank of a matroid is the cardinality of a basis
rank :: (Ord a) => Matroid a -> Int
rank :: Matroid a -> Int
rank m :: Matroid a
m = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall a. [a] -> a
head ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid a
m
-- rank m@(M es bs) = rankfun m es

-- Oxley p23
-- |Reconstruct a matroid from its elements and rank function
fromRankfun :: (Ord a) => [a] -> ([a] -> Int) -> Matroid a
fromRankfun :: [a] -> ([a] -> Int) -> Matroid a
fromRankfun es :: [a]
es rkf :: [a] -> Int
rkf = [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases [a]
es [[a]]
bs
    where b :: [a]
b = Int -> [a] -> [a] -> [a]
greedy 0 [] [a]
es -- first find any basis
          greedy :: Int -> [a] -> [a] -> [a]
greedy rk :: Int
rk ls :: [a]
ls (r :: a
r:rs :: [a]
rs) = let ls' :: [a]
ls' = [a]
ls [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
r] in
                                if [a] -> Int
rkf [a]
ls' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rkInt -> Int -> Int
forall a. Num a => a -> a -> a
+1
                                then Int -> [a] -> [a] -> [a]
greedy (Int
rkInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [a]
ls' [a]
rs
                                else Int -> [a] -> [a] -> [a]
greedy Int
rk [a]
ls [a]
rs
          greedy _ ls :: [a]
ls [] = [a]
ls
          rk :: Int
rk = [a] -> Int
rkf [a]
b
          isBasis :: [a] -> Bool
isBasis b' :: [a]
b' = [a] -> Int
rkf [a]
b' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rk
          bs :: [[a]]
bs = Set [a] -> Set [a] -> Set [a] -> [[a]]
closure Set [a]
forall a. Set a
S.empty ([a] -> Set [a]
forall a. a -> Set a
S.singleton [a]
b) Set [a]
forall a. Set a
S.empty -- now find all other bases by passing to "neighbouring" bases
          closure :: Set [a] -> Set [a] -> Set [a] -> [[a]]
closure interior :: Set [a]
interior boundary :: Set [a]
boundary exterior :: Set [a]
exterior =
              if Set [a] -> Bool
forall a. Set a -> Bool
S.null Set [a]
boundary
              then Set [a] -> [[a]]
forall a. Set a -> [a]
S.toList Set [a]
interior
              else let interior' :: Set [a]
interior' = Set [a]
interior Set [a] -> Set [a] -> Set [a]
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set [a]
boundary
                       candidates :: Set [a]
candidates = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [ [a]
b' | [a]
b <- Set [a] -> [[a]]
forall a. Set a -> [a]
S.toList Set [a]
boundary,
                                                      a
x <- [a]
b, a
y <- [a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b,
                                                      let b' :: [a]
b' = a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
L.insert a
y (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
x [a]
b),
                                                      [a]
b' [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set [a]
interior',
                                                      [a]
b' [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set [a]
exterior ]
                       (boundary' :: Set [a]
boundary', exterior' :: Set [a]
exterior') = ([a] -> Bool) -> Set [a] -> (Set [a], Set [a])
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
S.partition [a] -> Bool
isBasis Set [a]
candidates
                   in Set [a] -> Set [a] -> Set [a] -> [[a]]
closure Set [a]
interior' Set [a]
boundary' (Set [a] -> Set [a] -> Set [a]
forall a. Ord a => Set a -> Set a -> Set a
S.union Set [a]
exterior Set [a]
exterior')
-- The purpose of keeping track of exterior points we have encountered
-- is to avoid making repeat calls to the rank function rkf


-- CLOSURE OPERATOR AND FLATS

-- |Given a matroid m, @closure m@ is the closure operator on subsets of its element set
closure :: (Ord a) => Matroid a -> [a] -> [a]
closure :: Matroid a -> [a] -> [a]
closure m :: Matroid a
m xs :: [a]
xs = [a
x | a
x <- [a]
es, a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
xs Bool -> Bool -> Bool
|| Matroid a -> [a] -> Int
forall a. Ord a => Matroid a -> [a] -> Int
rankfun Matroid a
m (a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
L.insert a
x [a]
xs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rankxs]
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
          rankxs :: Int
rankxs = Matroid a -> [a] -> Int
forall a. Ord a => Matroid a -> [a] -> Int
rankfun Matroid a
m [a]
xs
-- The intuition is that closure xs is all elements within the span of xs

-- |Reconstruct a matroid from its elements and closure operator
fromClosure :: (Ord a) => [a] -> ([a] -> [a]) -> Matroid a
fromClosure :: [a] -> ([a] -> [a]) -> Matroid a
fromClosure es :: [a]
es cl :: [a] -> [a]
cl = [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases [a]
es [[a]]
bs
    where b :: [a]
b = [a] -> [a] -> [a] -> [a]
greedy ([a] -> [a]
cl []) [] [a]
es -- first find any basis
          greedy :: [a] -> [a] -> [a] -> [a]
greedy span :: [a]
span ls :: [a]
ls (r :: a
r:rs :: [a]
rs) = let ls' :: [a]
ls' = [a]
ls [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
r] in
                                  if a
r a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
span -- r is independent relative to ls
                                  then [a] -> [a] -> [a] -> [a]
greedy ([a] -> [a]
cl [a]
ls') [a]
ls' [a]
rs
                                  else [a] -> [a] -> [a] -> [a]
greedy [a]
span [a]
ls [a]
rs
          greedy _ ls :: [a]
ls [] = [a]
ls
          rk :: Int
rk = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
b
          isBasis :: [a] -> Bool
isBasis b' :: [a]
b' = [a] -> [a]
cl [a]
b' [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
es
          bs :: [[a]]
bs = Set [a] -> Set [a] -> Set [a] -> [[a]]
closure Set [a]
forall a. Set a
S.empty ([a] -> Set [a]
forall a. a -> Set a
S.singleton [a]
b) Set [a]
forall a. Set a
S.empty -- now find all other bases by passing to "neighbouring" bases
          closure :: Set [a] -> Set [a] -> Set [a] -> [[a]]
closure interior :: Set [a]
interior boundary :: Set [a]
boundary exterior :: Set [a]
exterior =
              if Set [a] -> Bool
forall a. Set a -> Bool
S.null Set [a]
boundary
              then Set [a] -> [[a]]
forall a. Set a -> [a]
S.toList Set [a]
interior
              else let interior' :: Set [a]
interior' = Set [a]
interior Set [a] -> Set [a] -> Set [a]
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set [a]
boundary
                       candidates :: Set [a]
candidates = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [ [a]
b' | [a]
b <- Set [a] -> [[a]]
forall a. Set a -> [a]
S.toList Set [a]
boundary,
                                                      a
x <- [a]
b, a
y <- [a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b,
                                                      let b' :: [a]
b' = a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
L.insert a
y (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
x [a]
b),
                                                      [a]
b' [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set [a]
interior',
                                                      [a]
b' [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set [a]
exterior ]
                       (boundary' :: Set [a]
boundary', exterior' :: Set [a]
exterior') = ([a] -> Bool) -> Set [a] -> (Set [a], Set [a])
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
S.partition [a] -> Bool
isBasis Set [a]
candidates
                   in Set [a] -> Set [a] -> Set [a] -> [[a]]
closure Set [a]
interior' Set [a]
boundary' (Set [a] -> Set [a] -> Set [a]
forall a. Ord a => Set a -> Set a -> Set a
S.union Set [a]
exterior Set [a]
exterior')
-- The purpose of keeping track of exterior points we have encountered
-- is to avoid making repeat calls to the closure operator cl

{-
-- Not quite sure why the following is so much slower than the above
-- May just be because Data.Set is compiled, and this would be comparable if also compiled
fromClosure2 es cl = M es bs
    where b = greedy (cl []) [] es -- first find any basis
          greedy span ls (r:rs) = let ls' = ls ++ [r] in
                                  if r `notElem` span -- r is independent relative to ls
                                  then greedy (cl ls') ls' rs
                                  else greedy span ls rs
          greedy _ ls [] = ls
          rk = length b
          isBasis b' = cl b' == es
          bs = closure tsempty [b] tsempty -- now find all other bases by passing to "neighbouring" bases
          closure interior boundary exterior =
              if null boundary
              then interior
              else let interior' = foldl' (flip tsinsert) interior boundary
                       candidates = [ b' | b <- boundary,
                                           x <- b, y <- es LS.\\ b,
                                           let b' = L.insert y (L.delete x b),
                                           not (b' `tsmember` interior'),
                                           not (b' `tsmember` exterior) ]
                       (boundary', exterior') = L.partition isBasis candidates
                   in closure interior' boundary' (foldl' (flip tsinsert) exterior exterior')
-}

-- |A flat in a matroid is a closed set, that is a set which is equal to its own closure
isFlat :: (Ord a) => Matroid a -> [a] -> Bool
isFlat :: Matroid a -> [a] -> Bool
isFlat m :: Matroid a
m xs :: [a]
xs = Matroid a -> [a] -> [a]
forall a. Ord a => Matroid a -> [a] -> [a]
closure Matroid a
m [a]
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
xs

flats1 :: Matroid a -> [[a]]
flats1 m :: Matroid a
m = [[a]
xs | [a]
xs <- [a] -> [[a]]
forall a. [a] -> [[a]]
powersetbfs [a]
es, Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isFlat Matroid a
m [a]
xs]
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
-- first, inefficient, implementation

-- given xs, a flat in m, return the flats which cover xs
-- these have the property that they partition es \\ xs
coveringFlats :: Matroid a -> [a] -> [[a]]
coveringFlats m :: Matroid a
m xs :: [a]
xs = [a] -> [[a]]
coveringFlats' ([a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
xs)
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
          coveringFlats' :: [a] -> [[a]]
coveringFlats' (y :: a
y:ys :: [a]
ys) = let zs :: [a]
zs = Matroid a -> [a] -> [a]
forall a. Ord a => Matroid a -> [a] -> [a]
closure Matroid a
m (a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
L.insert a
y [a]
xs)
                                  in [a]
zs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
coveringFlats' ([a]
ys [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
zs)
          coveringFlats' [] = []

-- since we are dealing with finite matroids, the lattice of flats is finite, so it has a minimal element
minimalFlat :: Matroid a -> [a]
minimalFlat m :: Matroid a
m = [[a]] -> [a]
forall a. [a] -> a
head ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isFlat Matroid a
m) ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. [a] -> [[a]]
powersetbfs ([a] -> [[a]]) -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m

-- |The flats of a matroid are its closed sets. They form a lattice under inclusion.
flats :: (Ord a) => Matroid a -> [[a]]
flats :: Matroid a -> [[a]]
flats m :: Matroid a
m = Set [a] -> [[a]] -> [[a]]
flats' Set [a]
forall a. Set a
S.empty [Matroid a -> [a]
forall a. Ord a => Matroid a -> [a]
minimalFlat Matroid a
m]
    where flats' :: Set [a] -> [[a]] -> [[a]]
flats' ls :: Set [a]
ls (r :: [a]
r:rs :: [[a]]
rs) = if [a]
r [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
ls
                             then Set [a] -> [[a]] -> [[a]]
flats' Set [a]
ls [[a]]
rs
                             else Set [a] -> [[a]] -> [[a]]
flats' ([a] -> Set [a] -> Set [a]
forall a. Ord a => a -> Set a -> Set a
S.insert [a]
r Set [a]
ls) ([[a]]
rs [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ Matroid a -> [a] -> [[a]]
forall a. Ord a => Matroid a -> [a] -> [[a]]
coveringFlats Matroid a
m [a]
r)
          flats' ls :: Set [a]
ls [] = [[a]] -> [[a]]
forall (t :: * -> *) a. (Ord (t a), Foldable t) => [t a] -> [t a]
toShortlex ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ Set [a] -> [[a]]
forall a. Set a -> [a]
S.toList Set [a]
ls
          -- this is just breadth-first search

-- isMatroidFlats
-- Oxley p31-32
{-
isMatroidFlats es fs =
    es `elem` fs &&
    [ (f1 `LS.intersect` f2) `elem` fs | f1 <- fs, f2 <- fs ] &&
    -- for all flats f, the minimal flats containing f partition es-f
-}

-- |Reconstruct a matroid from its flats. (The flats must be given in shortlex order.)
fromFlats :: (Ord a) => [[a]] -> Matroid a
fromFlats :: [[a]] -> Matroid a
fromFlats fs :: [[a]]
fs | [[a]] -> Bool
forall (t :: * -> *) a. (Foldable t, Ord (t a)) => [t a] -> Bool
isShortlex [[a]]
fs = [[a]] -> Matroid a
forall a. Ord a => [[a]] -> Matroid a
fromFlats' [[a]]
fs
             | Bool
otherwise = [Char] -> Matroid a
forall a. HasCallStack => [Char] -> a
error "fromFlats: flats must be in shortlex order"

fromFlats' :: [[a]] -> Matroid a
fromFlats' fs :: [[a]]
fs = [a] -> ([a] -> [a]) -> Matroid a
forall a. Ord a => [a] -> ([a] -> [a]) -> Matroid a
fromClosure [a]
es [a] -> [a]
cl
    where es :: [a]
es = [[a]] -> [a]
forall a. [a] -> a
last [[a]]
fs -- es is a flat, and last in shortlex order
          cl :: [a] -> [a]
cl xs :: [a]
xs = [[a]] -> [a]
forall a. [a] -> a
head [[a]
f | [a]
f <- [[a]]
fs, [a]
xs [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`LS.isSubset` [a]
f] -- the first flat is minimal, because of shortlex order
-- !! we can probably do better (efficiency-wise)
-- eg by constructing the lattice as a DAG, and climbing up it

-- |A subset of the elements in a matroid is spanning if its closure is all the elements
isSpanning :: (Ord a) => Matroid a -> [a] -> Bool
isSpanning :: Matroid a -> [a] -> Bool
isSpanning m :: Matroid a
m xs :: [a]
xs = Matroid a -> [a] -> [a]
forall a. Ord a => Matroid a -> [a] -> [a]
closure Matroid a
m [a]
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
es
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m

-- |A hyperplane is a flat whose rank is one less than that of the matroid
isHyperplane :: (Ord a) => Matroid a -> [a] -> Bool
isHyperplane :: Matroid a -> [a] -> Bool
isHyperplane m :: Matroid a
m xs :: [a]
xs = Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isFlat Matroid a
m [a]
xs Bool -> Bool -> Bool
&& Matroid a -> [a] -> Int
forall a. Ord a => Matroid a -> [a] -> Int
rankfun Matroid a
m [a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Matroid a -> Int
forall a. Ord a => Matroid a -> Int
rank Matroid a
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1

hyperplanes1 :: Matroid a -> [[a]]
hyperplanes1 m :: Matroid a
m = [[a]
h | [a]
h <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
flats Matroid a
m, Matroid a -> [a] -> Int
forall a. Ord a => Matroid a -> [a] -> Int
rankfun Matroid a
m [a]
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rk Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
    where rk :: Int
rk = Matroid a -> Int
forall a. Ord a => Matroid a -> Int
rank Matroid a
m

-- Oxley p65: h is a hyperplane iff its complement is a cocircuit
hyperplanes :: (Ord a) => Matroid a -> [[a]]
hyperplanes :: Matroid a -> [[a]]
hyperplanes m :: Matroid a
m = [[a]] -> [[a]]
forall (t :: * -> *) a. (Ord (t a), Foldable t) => [t a] -> [t a]
toShortlex ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
complement ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
cocircuits Matroid a
m
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
          complement :: [a] -> [a]
complement cc :: [a]
cc = [a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
cc
-- This appears to be faster than hyperplanes1

-- Oxley p70
isMatroidHyperplanes :: (Ord a) => [a] -> [[a]] -> Bool
isMatroidHyperplanes :: [a] -> [[a]] -> Bool
isMatroidHyperplanes es :: [a]
es hs :: [[a]]
hs =
    [a]
es [a] -> [[a]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[a]]
hs Bool -> Bool -> Bool
&&
    [[a]] -> Bool
forall a. Ord a => [[a]] -> Bool
isClutter [[a]]
hs Bool -> Bool -> Bool
&&
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
exists [[a]
h3 | [a]
h3 <- [[a]]
hs, [a]
h12e [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`LS.isSubset` [a]
h3] | (h1 :: [a]
h1,h2 :: [a]
h2) <- [[a]] -> [([a], [a])]
forall t. [t] -> [(t, t)]
pairs [[a]]
hs,
                                                          a
e <- [a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ ([a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.union [a]
h1 [a]
h2),
                                                          let h12e :: [a]
h12e = a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
L.insert a
e ([a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.intersect [a]
h1 [a]
h2) ]
-- Note that contrary to what one might initially think
-- it does *not* follow from the third condition that every element is in some hyperplane
-- since there might be only one hyperplane, eg fromBases [1,2] [[2]] has [1] as it's only hyperplane

-- Haven't actually proven that the following is always correct
-- but it seems to work
fromHyperplanes1 :: [a] -> [[a]] -> Matroid a
fromHyperplanes1 es :: [a]
es hs :: [[a]]
hs = [[a]] -> Matroid a
forall a. Ord a => [[a]] -> Matroid a
fromFlats ([[a]] -> Matroid a) -> [[a]] -> Matroid a
forall a b. (a -> b) -> a -> b
$ Set [a] -> Set [a] -> [[a]]
closure Set [a]
forall a. Set a
S.empty ([[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
hs)
    where closure :: Set [a] -> Set [a] -> [[a]]
closure interior :: Set [a]
interior boundary :: Set [a]
boundary =
              if Set [a] -> Bool
forall a. Set a -> Bool
S.null Set [a]
boundary
              then ([[a]] -> [[a]]
forall (t :: * -> *) a. (Ord (t a), Foldable t) => [t a] -> [t a]
toShortlex ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ Set [a] -> [[a]]
forall a. Set a -> [a]
S.toList Set [a]
interior) [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]
es]
              else let interior' :: Set [a]
interior' = Set [a] -> Set [a] -> Set [a]
forall a. Ord a => Set a -> Set a -> Set a
S.union Set [a]
interior Set [a]
boundary
                       boundary' :: Set [a]
boundary' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [ [a]
f1 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`LS.intersect` [a]
f2 | (f1 :: [a]
f1,f2 :: [a]
f2) <- [[a]] -> [([a], [a])]
forall t. [t] -> [(t, t)]
pairs (Set [a] -> [[a]]
forall a. Set a -> [a]
S.toList Set [a]
boundary) ]
                                   Set [a] -> Set [a] -> Set [a]
forall a. Ord a => Set a -> Set a -> Set a
S.\\ Set [a]
interior'
                   in Set [a] -> Set [a] -> [[a]]
closure Set [a]
interior' Set [a]
boundary'

-- |Reconstruct a matroid from its elements and hyperplanes
fromHyperplanes :: (Ord a) => [a] -> [[a]] -> Matroid a
fromHyperplanes :: [a] -> [[a]] -> Matroid a
fromHyperplanes es :: [a]
es hs :: [[a]]
hs = [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromCocircuits [a]
es ([[a]] -> Matroid a) -> [[a]] -> Matroid a
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
complement [[a]]
hs
    where fromCocircuits :: [a] -> [[a]] -> Matroid a
fromCocircuits es :: [a]
es = Matroid a -> Matroid a
forall a. Ord a => Matroid a -> Matroid a
dual (Matroid a -> Matroid a)
-> ([[a]] -> Matroid a) -> [[a]] -> Matroid a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromCircuits [a]
es
          complement :: [a] -> [a]
complement xs :: [a]
xs = [a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
xs


-- GEOMETRIC REPRESENTATION

-- |Given a list of points in k^n, number the points [1..], and construct the matroid whose independent sets
-- correspond to those sets of points which are affinely independent.
--
-- A multiset of points in k^n is said to be affinely dependent if it contains two identical points,
-- or three collinear points, or four coplanar points, or ... - and affinely independent otherwise.
affineMatroid :: (Eq k, Fractional k) => [[k]] -> Matroid Int
affineMatroid :: [[k]] -> Matroid Int
affineMatroid vs :: [[k]]
vs = [[k]] -> Matroid Int
forall k. (Eq k, Fractional k) => [[k]] -> Matroid Int
vectorMatroid' ([[k]] -> Matroid Int) -> [[k]] -> Matroid Int
forall a b. (a -> b) -> a -> b
$ ([k] -> [k]) -> [[k]] -> [[k]]
forall a b. (a -> b) -> [a] -> [b]
map (1k -> [k] -> [k]
forall a. a -> [a] -> [a]
:) [[k]]
vs

-- |fromGeoRep returns a matroid from a geometric representation consisting of dependent flats of various ranks.
-- Given lists of dependent rank 0 flats (loops), rank 1 flats (points), rank 2 flats (lines) and rank 3 flats (planes),
-- @fromGeoRep loops points lines planes@ returns the matroid having these as dependent flats.
-- Note that if all the elements lie in the same plane, then this should still be listed as an argument.
fromGeoRep :: (Ord a) => [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
fromGeoRep :: [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
fromGeoRep loops :: [[a]]
loops points :: [[a]]
points lines :: [[a]]
lines planes :: [[a]]
planes =
    [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromCircuits [a]
es ([[a]] -> Matroid a) -> [[a]] -> Matroid a
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]]
forall a. Ord a => [[a]] -> [[a]]
minimal ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$
        [[a]]
loops [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++
        ([a] -> [[a]]) -> [[a]] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2) [[a]]
points [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++
        ([a] -> [[a]]) -> [[a]] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinationsOf 3) [[a]]
lines [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++
        ([a] -> [[a]]) -> [[a]] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinationsOf 4) [[a]]
planes [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++
        Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinationsOf 5 [a]
es
    where es :: [a]
es = [a] -> [a]
forall a. Ord a => [a] -> [a]
toSet ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
loops [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
points [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
lines [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
planes

-- Note that we don't check that the inputs are valid

-- xss assumed to be in shortlex order
minimal :: [[a]] -> [[a]]
minimal xss :: [[a]]
xss = [[a]] -> [[a]] -> [[a]]
forall a. Ord a => [[a]] -> [[a]] -> [[a]]
minimal' [] [[a]]
xss
    where minimal' :: [[a]] -> [[a]] -> [[a]]
minimal' ls :: [[a]]
ls (r :: [a]
r:rs :: [[a]]
rs) = if ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`LS.isSubset` [a]
r) [[a]]
ls
                               then [[a]] -> [[a]] -> [[a]]
minimal' [[a]]
ls [[a]]
rs
                               else [[a]] -> [[a]] -> [[a]]
minimal' ([a]
r[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ls) [[a]]
rs
          minimal' ls :: [[a]]
ls [] = [[a]] -> [[a]]
forall a. [a] -> [a]
reverse [[a]]
ls

-- |A simple matroid has no loops or parallel elements, hence its geometric representation has no loops or dependent points.
-- @simpleFromGeoRep lines planes@ returns the simple matroid having these dependent flats.
simpleFromGeoRep :: (Ord a) => [[a]] -> [[a]] -> Matroid a
simpleFromGeoRep :: [[a]] -> [[a]] -> Matroid a
simpleFromGeoRep lines :: [[a]]
lines planes :: [[a]]
planes = [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
forall a. Ord a => [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
fromGeoRep [] []  [[a]]
lines [[a]]
planes

-- Oxley p37-8
isSimpleGeoRep :: [[a]] -> [[a]] -> Bool
isSimpleGeoRep lines :: [[a]]
lines planes :: [[a]]
planes =
    ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ) [ [a]
l1 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`LS.intersect` [a]
l2 | (l1 :: [a]
l1,l2 :: [a]
l2) <- [[a]] -> [([a], [a])]
forall t. [t] -> [(t, t)]
pairs [[a]]
lines ] Bool -> Bool -> Bool
&&
    ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( \i :: [a]
i -> [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2 Bool -> Bool -> Bool
|| [a]
i [a] -> [[a]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[a]]
lines ) [ [a]
p1 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`LS.intersect` [a]
p2 | (p1 :: [a]
p1,p2 :: [a]
p2) <- [[a]] -> [([a], [a])]
forall t. [t] -> [(t, t)]
pairs [[a]]
planes ] Bool -> Bool -> Bool
&&
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([a]
u [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`LS.isSubset`) [[a]]
planes | (l1 :: [a]
l1,l2 :: [a]
l2) <- [[a]] -> [([a], [a])]
forall t. [t] -> [(t, t)]
pairs [[a]]
lines, [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a]
l1 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`LS.intersect` [a]
l2) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1, let u :: [a]
u = [a]
l1 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`LS.union` [a]
l2 ] Bool -> Bool -> Bool
&&
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
|| [a]
i [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
l | [a]
l <- [[a]]
lines, [a]
p <- [[a]]
planes, let i :: [a]
i = [a]
l [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`LS.intersect` [a]
p ]


isCircuitHyperplane :: Matroid a -> [a] -> Bool
isCircuitHyperplane m :: Matroid a
m xs :: [a]
xs = Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isCircuit Matroid a
m [a]
xs Bool -> Bool -> Bool
&& Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isHyperplane Matroid a
m [a]
xs

-- |List the circuit-hyperplanes of a matroid.
circuitHyperplanes :: (Ord a) => Matroid a -> [[a]]
circuitHyperplanes :: Matroid a -> [[a]]
circuitHyperplanes m :: Matroid a
m = [ [a]
h | [a]
h <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
hyperplanes Matroid a
m, Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isCircuit Matroid a
m [a]
h ] 

-- Oxley p39
-- |Given a matroid m, and a set of elements b which is both a circuit and a hyperplane in m,
-- then @relaxation m b@ is the matroid which is obtained by adding b as a new basis.
-- This corresponds to removing b from the geometric representation of m.
relaxation :: (Ord a) => Matroid a -> [a] -> Matroid a
relaxation :: Matroid a -> [a] -> Matroid a
relaxation m :: Matroid a
m b :: [a]
b
    | Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isCircuitHyperplane Matroid a
m [a]
b = [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases [a]
es [[a]]
bs
    | Bool
otherwise = [Char] -> Matroid a
forall a. HasCallStack => [Char] -> a
error "relaxation: not a circuit-hyperplane"
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
          bs :: [[a]]
bs = [a]
b [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid a
m 


-- TRANSVERSAL MATROIDS

ex161 :: [[a]]
ex161 = [ [1,2,6], [3,4,5,6], [2,3], [2,4,6] ]

-- the edges of the bipartite graph
transversalGraph :: [[a]] -> [(Either a b, Either a b)]
transversalGraph as :: [[a]]
as = [(a -> Either a b
forall a b. a -> Either a b
Left a
x, b -> Either a b
forall a b. b -> Either a b
Right b
i) | (a :: [a]
a,i :: b
i) <- [[a]] -> [b] -> [([a], b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[a]]
as [1..], a
x <- [a]
a]

partialMatchings :: [(a, a)] -> [[(a, a)]]
partialMatchings es :: [(a, a)]
es = [(Set a, [(a, a)], [(a, a)])] -> [[(a, a)]]
forall a. Ord a => [(Set a, [(a, a)], [(a, a)])] -> [[(a, a)]]
dfs [(Set a
forall a. Set a
S.empty, [], [(a, a)]
es)]
    where dfs :: [(Set a, [(a, a)], [(a, a)])] -> [[(a, a)]]
dfs (node :: (Set a, [(a, a)], [(a, a)])
node@(vs :: Set a
vs,ls :: [(a, a)]
ls,rs :: [(a, a)]
rs): nodes :: [(Set a, [(a, a)], [(a, a)])]
nodes) = [(a, a)]
ls [(a, a)] -> [[(a, a)]] -> [[(a, a)]]
forall a. a -> [a] -> [a]
: [(Set a, [(a, a)], [(a, a)])] -> [[(a, a)]]
dfs ((Set a, [(a, a)], [(a, a)]) -> [(Set a, [(a, a)], [(a, a)])]
forall a.
Ord a =>
(Set a, [(a, a)], [(a, a)]) -> [(Set a, [(a, a)], [(a, a)])]
successors (Set a, [(a, a)], [(a, a)])
node [(Set a, [(a, a)], [(a, a)])]
-> [(Set a, [(a, a)], [(a, a)])] -> [(Set a, [(a, a)], [(a, a)])]
forall a. [a] -> [a] -> [a]
++ [(Set a, [(a, a)], [(a, a)])]
nodes)
          dfs [] = []
          successors :: (Set a, [(a, a)], [(a, a)]) -> [(Set a, [(a, a)], [(a, a)])]
successors (vs :: Set a
vs,ls :: [(a, a)]
ls,rs :: [(a, a)]
rs) =  [ (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
u (Set a -> Set a) -> Set a -> Set 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
v Set a
vs, (a, a) -> [(a, a)] -> [(a, a)]
forall a. Ord a => a -> [a] -> [a]
L.insert (a, a)
r [(a, a)]
ls, [(a, a)]
rs')
                                   | r :: (a, a)
r@(u :: a
u,v :: a
v):rs' :: [(a, a)]
rs' <- [(a, a)] -> [[(a, a)]]
forall a. [a] -> [[a]]
L.tails [(a, a)]
rs, a
u a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set a
vs, a
v a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set a
vs ]

-- |Given a set of elements es, and a sequence as = [a1,...,am] of subsets of es,
-- return the matroid whose independent sets are the partial transversals of the as.
transversalMatroid :: (Ord a) => [a] -> [[a]] -> Matroid a
transversalMatroid :: [a] -> [[a]] -> Matroid a
transversalMatroid es :: [a]
es as :: [[a]]
as = [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases [a]
es [[a]]
bs
    where is :: [[a]]
is@(i :: [a]
i:_) = [[a]] -> [[a]]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]]
forall (t :: * -> *) a. (Ord (t a), Foldable t) => [t a] -> [t a]
toShortlex ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]]
forall a. Ord a => [a] -> [a]
toSet ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ (([(Either a Integer, Either a Integer)] -> [a])
-> [[(Either a Integer, Either a Integer)]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (([(Either a Integer, Either a Integer)] -> [a])
 -> [[(Either a Integer, Either a Integer)]] -> [[a]])
-> (((Either a Integer, Either a Integer) -> a)
    -> [(Either a Integer, Either a Integer)] -> [a])
-> ((Either a Integer, Either a Integer) -> a)
-> [[(Either a Integer, Either a Integer)]]
-> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either a Integer, Either a Integer) -> a)
-> [(Either a Integer, Either a Integer)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map) (Either a Integer -> a
forall a b. Either a b -> a
unLeft (Either a Integer -> a)
-> ((Either a Integer, Either a Integer) -> Either a Integer)
-> (Either a Integer, Either a Integer)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a Integer, Either a Integer) -> Either a Integer
forall a b. (a, b) -> a
fst) ([[(Either a Integer, Either a Integer)]] -> [[a]])
-> [[(Either a Integer, Either a Integer)]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [(Either a Integer, Either a Integer)]
-> [[(Either a Integer, Either a Integer)]]
forall a. Ord a => [(a, a)] -> [[(a, a)]]
partialMatchings ([[a]] -> [(Either a Integer, Either a Integer)]
forall b a b a.
(Num b, Enum b) =>
[[a]] -> [(Either a b, Either a b)]
transversalGraph [[a]]
as)
          unLeft :: Either a b -> a
unLeft (Left x :: a
x) = a
x
          l :: Int
l = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
i
          bs :: [[a]]
bs = [[a]] -> [[a]]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ( (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ) [[a]]
is
-- In this case, as is called a presentation of the matroid
-- Note that there may be partial transversals even if there are no transversals


-- Not obvious how to efficiently find the bases without finding the independent sets,
-- since neighbouring partial transversals might arise in different ways
-- (Although Oxley p93 seems to be saying that they don't)
{-
transversalMatroid2 es as = fromBases es bs
    where es' = transversalGraph as
          b = greedy [] es' -- first find any basis
          greedy ls (r@(u,v):rs) = if u `notElem` map fst ls && v `notElem` map snd ls
                                   then greedy (r:ls) rs
                                   else greedy ls rs
          greedy ls [] = ls
-- now choose the subset of the as indicated by the Right part of b
-- and seek all full transversals
          bs = closure S.empty (S.singleton b) -- now find all other bases by passing to "neighbouring" bases
          closure interior boundary =
              if S.null boundary
              then S.toList interior
              else let interior' = interior `S.union` boundary
                       boundary' = S.fromList [ b' | b <- S.toList boundary,
                                                     x <- b, y <- es LS.\\ b,
                                                     let b' = L.insert y (L.delete x b),
                                                     b' `S.notMember` interior',
                                                     cl b' == es ] -- b' is spanning, and same size as b, hence must be basis
                                   -- S.\\ interior'
                   in closure interior' boundary'
-}


-- DUALITY

-- |The dual matroid
dual :: (Ord a) => Matroid a -> Matroid a
dual :: Matroid a -> Matroid a
dual m :: Matroid a
m = [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases [a]
es [[a]]
bs'
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
          bs :: [[a]]
bs = Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid a
m
          bs' :: [[a]]
bs' = [[a]] -> [[a]]
forall a. Ord a => [a] -> [a]
L.sort ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ([a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\) [[a]]
bs

isCoindependent :: Matroid a -> [a] -> Bool
isCoindependent m :: Matroid a
m xs :: [a]
xs = Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isIndependent (Matroid a -> Matroid a
forall a. Ord a => Matroid a -> Matroid a
dual Matroid a
m) [a]
xs

isCobase :: Matroid a -> [a] -> Bool
isCobase m :: Matroid a
m xs :: [a]
xs = Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isBase (Matroid a -> Matroid a
forall a. Ord a => Matroid a -> Matroid a
dual Matroid a
m) [a]
xs
-- quicker but less clear to calculate this directly

isCocircuit :: Matroid a -> [a] -> Bool
isCocircuit m :: Matroid a
m xs :: [a]
xs = Matroid a -> [a] -> Bool
forall a. Ord a => Matroid a -> [a] -> Bool
isCircuit (Matroid a -> Matroid a
forall a. Ord a => Matroid a -> Matroid a
dual Matroid a
m) [a]
xs

cocircuits :: (Ord a) => Matroid a -> [[a]]
cocircuits :: Matroid a -> [[a]]
cocircuits m :: Matroid a
m = Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits (Matroid a -> Matroid a
forall a. Ord a => Matroid a -> Matroid a
dual Matroid a
m)

isColoop :: Matroid a -> a -> Bool
isColoop m :: Matroid a
m e :: a
e = Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isLoop (Matroid a -> Matroid a
forall a. Ord a => Matroid a -> Matroid a
dual Matroid a
m) a
e

isCoparallel :: Matroid a -> a -> a -> Bool
isCoparallel m :: Matroid a
m f :: a
f g :: a
g = Matroid a -> a -> a -> Bool
forall a. Ord a => Matroid a -> a -> a -> Bool
isParallel (Matroid a -> Matroid a
forall a. Ord a => Matroid a -> Matroid a
dual Matroid a
m) a
f a
g


-- MINORS

deletion :: (Ord a) => Matroid a -> [a] -> Matroid a
deletion :: Matroid a -> [a] -> Matroid a
deletion m :: Matroid a
m xs :: [a]
xs = Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
restriction Matroid a
m ([a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
xs)
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m

\\\ :: Matroid a -> [a] -> Matroid a
(\\\) = Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
deletion

contraction :: (Ord a) => Matroid a -> [a] -> Matroid a
contraction :: Matroid a -> [a] -> Matroid a
contraction m :: Matroid a
m xs :: [a]
xs = Matroid a -> Matroid a
forall a. Ord a => Matroid a -> Matroid a
dual (Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
deletion (Matroid a -> Matroid a
forall a. Ord a => Matroid a -> Matroid a
dual Matroid a
m) [a]
xs)

/// :: Matroid a -> [a] -> Matroid a
(///) = Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
contraction


-- CONNECTIVITY

-- Oxley p120
-- |A matroid is (2-)connected if, for every pair of distinct elements, there is a circuit containing both
isConnected :: (Ord a) => Matroid a -> Bool
isConnected :: Matroid a -> Bool
isConnected m :: Matroid a
m = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([a]
pair [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`LS.isSubset`) [[a]]
cs | [a]
pair <- Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [a]
es]
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
          cs :: [[a]]
cs = Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m

component :: Matroid a -> a -> [a]
component m :: Matroid a
m x :: a
x = Set a -> Set a -> [a]
closure Set a
forall a. Set a
S.empty (a -> Set a
forall a. a -> Set a
S.singleton a
x)
    where cs :: [[a]]
cs = Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m
          closure :: Set a -> Set a -> [a]
closure interior :: Set a
interior boundary :: Set a
boundary =
              if Set a -> Bool
forall a. Set a -> Bool
S.null Set a
boundary
              then Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
interior
              else let interior' :: Set a
interior' = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
interior Set a
boundary
                       boundary' :: Set a
boundary' = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]
c | [a]
c <- [[a]]
cs, (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.intersect [a]
c (Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
boundary)) ])
                                   Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.\\ Set a
interior'
                   in Set a -> Set a -> [a]
closure Set a
interior' Set a
boundary'

-- |The direct sum of two matroids
dsum :: (Ord a, Ord b) => Matroid a -> Matroid b -> Matroid (Either a b)
dsum :: Matroid a -> Matroid b -> Matroid (Either a b)
dsum m1 :: Matroid a
m1 m2 :: Matroid b
m2 = [Either a b] -> [[Either a b]] -> Matroid (Either a b)
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases [Either a b]
es [[Either a b]]
bs
    where es :: [Either a b]
es = (a -> Either a b) -> [a] -> [Either a b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Either a b
forall a b. a -> Either a b
Left (Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m1) [Either a b] -> [Either a b] -> [Either a b]
forall a. [a] -> [a] -> [a]
++ (b -> Either a b) -> [b] -> [Either a b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Either a b
forall a b. b -> Either a b
Right (Matroid b -> [b]
forall t. Matroid t -> [t]
elements Matroid b
m2)
          bs :: [[Either a b]]
bs = [(a -> Either a b) -> [a] -> [Either a b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Either a b
forall a b. a -> Either a b
Left [a]
b1 [Either a b] -> [Either a b] -> [Either a b]
forall a. [a] -> [a] -> [a]
++ (b -> Either a b) -> [b] -> [Either a b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Either a b
forall a b. b -> Either a b
Right [b]
b2 | [a]
b1 <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid a
m1, [b]
b2 <- Matroid b -> [[b]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid b
m2]


-- REPRESENTABILITY

-- |@matroidPG n fq@ returns the projective geometry PG(n,Fq), where fq is a list of the elements of Fq
matroidPG :: (Eq a, Fractional a) => Int -> [a] -> Matroid Int
matroidPG :: Int -> [a] -> Matroid Int
matroidPG n :: Int
n fq :: [a]
fq = [[a]] -> Matroid Int
forall k. (Eq k, Fractional k) => [[k]] -> Matroid Int
vectorMatroid' ([[a]] -> Matroid Int) -> [[a]] -> Matroid Int
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [[a]]
forall a. Num a => Int -> [a] -> [[a]]
ptsPG Int
n [a]
fq

-- |@matroidAG n fq@ returns the affine geometry AG(n,Fq), where fq is a list of the elements of Fq
matroidAG :: (Eq a, Fractional a) => Int -> [a] -> Matroid Int
matroidAG :: Int -> [a] -> Matroid Int
matroidAG n :: Int
n fq :: [a]
fq = [[a]] -> Matroid Int
forall k. (Eq k, Fractional k) => [[k]] -> Matroid Int
vectorMatroid' ([[a]] -> Matroid Int) -> [[a]] -> Matroid Int
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
ptsAG Int
n [a]
fq


-- Oxley p182
-- |Given a matroid m, the fundamental-circuit incidence matrix relative to a base b
-- has rows indexed by the elements of b, and columns indexed by the elements not in b.
-- The bi, ej entry is 1 if bi is in the fundamental circuit of ej relative to b, and 0 otherwise.
fundamentalCircuitIncidenceMatrix :: (Ord a, Num k) => Matroid a -> [a] -> [[k]]
fundamentalCircuitIncidenceMatrix :: Matroid a -> [a] -> [[k]]
fundamentalCircuitIncidenceMatrix m :: Matroid a
m b :: [a]
b = [[k]] -> [[k]]
forall a. [[a]] -> [[a]]
L.transpose ([[k]] -> [[k]]) -> [[k]] -> [[k]]
forall a b. (a -> b) -> a -> b
$ Matroid a -> [a] -> [[k]]
forall a a. (Ord a, Num a) => Matroid a -> [a] -> [[a]]
fundamentalCircuitIncidenceMatrix' Matroid a
m [a]
b

fundamentalCircuitIncidenceMatrix' :: Matroid a -> [a] -> [[a]]
fundamentalCircuitIncidenceMatrix' m :: Matroid a
m b :: [a]
b =
    [ [if a
e a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Matroid a -> [a] -> a -> [a]
forall a. Ord a => Matroid a -> [a] -> a -> [a]
fundamentalCircuit Matroid a
m [a]
b a
e' then 1 else 0 | a
e <- [a]
b]
    | a
e' <- Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b ]

fcim :: Matroid a -> [a] -> [[k]]
fcim = Matroid a -> [a] -> [[k]]
forall a a. (Ord a, Num a) => Matroid a -> [a] -> [[a]]
fundamentalCircuitIncidenceMatrix
fcim' :: Matroid a -> [a] -> [[a]]
fcim' = Matroid a -> [a] -> [[a]]
forall a a. (Ord a, Num a) => Matroid a -> [a] -> [[a]]
fundamentalCircuitIncidenceMatrix'

-- Then fcim w4 [1..4] == L.transpose (fcim (dual w4) [5..8])


-- Given a matrix of 0s and 1s, return a matrix of 0s, 1s and *s
-- where 0 -> 0, and 1 -> 1 if it is the first 1 in either a row or column, 1 -> * otherwise
markNonInitialRCs :: [[a]] -> [[ZeroOneStar]]
markNonInitialRCs mx :: [[a]]
mx = [Bool] -> [[a]] -> [[ZeroOneStar]]
forall a. (Eq a, Num a) => [Bool] -> [[a]] -> [[ZeroOneStar]]
mark (Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
w Bool
False) [[a]]
mx
    where w :: Int
w = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall a. [a] -> a
head [[a]]
mx -- the width
          mark :: [Bool] -> [[a]] -> [[ZeroOneStar]]
mark cms :: [Bool]
cms (r :: [a]
r:rs :: [[a]]
rs) = let (cms' :: [Bool]
cms', r' :: [ZeroOneStar]
r') = Bool
-> [Bool]
-> [Bool]
-> [ZeroOneStar]
-> [a]
-> ([Bool], [ZeroOneStar])
forall a.
(Eq a, Num a) =>
Bool
-> [Bool]
-> [Bool]
-> [ZeroOneStar]
-> [a]
-> ([Bool], [ZeroOneStar])
mark' Bool
False [] [Bool]
cms [] [a]
r in [ZeroOneStar]
r' [ZeroOneStar] -> [[ZeroOneStar]] -> [[ZeroOneStar]]
forall a. a -> [a] -> [a]
: [Bool] -> [[a]] -> [[ZeroOneStar]]
mark [Bool]
cms' [[a]]
rs
          mark _ [] = []
          mark' :: Bool
-> [Bool]
-> [Bool]
-> [ZeroOneStar]
-> [a]
-> ([Bool], [ZeroOneStar])
mark' rm :: Bool
rm cms' :: [Bool]
cms' (cm :: Bool
cm:cms :: [Bool]
cms) ys :: [ZeroOneStar]
ys (x :: a
x:xs :: [a]
xs)
              | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Bool
-> [Bool]
-> [Bool]
-> [ZeroOneStar]
-> [a]
-> ([Bool], [ZeroOneStar])
mark' Bool
rm (Bool
cmBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
cms') [Bool]
cms (ZeroOneStar
ZeroZeroOneStar -> [ZeroOneStar] -> [ZeroOneStar]
forall a. a -> [a] -> [a]
:[ZeroOneStar]
ys) [a]
xs
              | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = if Bool
rm Bool -> Bool -> Bool
&& Bool
cm
                         then Bool
-> [Bool]
-> [Bool]
-> [ZeroOneStar]
-> [a]
-> ([Bool], [ZeroOneStar])
mark' Bool
True (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
cms') [Bool]
cms (ZeroOneStar
StarZeroOneStar -> [ZeroOneStar] -> [ZeroOneStar]
forall a. a -> [a] -> [a]
:[ZeroOneStar]
ys) [a]
xs
                         else Bool
-> [Bool]
-> [Bool]
-> [ZeroOneStar]
-> [a]
-> ([Bool], [ZeroOneStar])
mark' Bool
True (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
cms') [Bool]
cms (ZeroOneStar
OneZeroOneStar -> [ZeroOneStar] -> [ZeroOneStar]
forall a. a -> [a] -> [a]
:[ZeroOneStar]
ys) [a]
xs
          mark' _ cms' :: [Bool]
cms' [] ys :: [ZeroOneStar]
ys [] = ([Bool] -> [Bool]
forall a. [a] -> [a]
reverse [Bool]
cms', [ZeroOneStar] -> [ZeroOneStar]
forall a. [a] -> [a]
reverse [ZeroOneStar]
ys)

-- Given a matrix of 0s, 1s and *s, return all distinct matrices that can be obtained
-- by substituting non-zero elements of Fq for the *s
substStars :: [[ZeroOneStar]] -> [a] -> [[[a]]]
substStars mx :: [[ZeroOneStar]]
mx fq :: [a]
fq = [[ZeroOneStar]] -> [[[a]]]
substStars' [[ZeroOneStar]]
mx
    where fq' :: [a]
fq' = [a] -> [a]
forall a. [a] -> [a]
tail [a]
fq -- non-zero elts of fq
          substStars' :: [[ZeroOneStar]] -> [[[a]]]
substStars' (r :: [ZeroOneStar]
r:rs :: [[ZeroOneStar]]
rs) = [[a]
r'[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
rs' | [a]
r' <- [ZeroOneStar] -> [[a]]
substStars'' [ZeroOneStar]
r, [[a]]
rs' <- [[ZeroOneStar]] -> [[[a]]]
substStars' [[ZeroOneStar]]
rs]
          substStars' [] = [[]]
          substStars'' :: [ZeroOneStar] -> [[a]]
substStars'' (Zero:xs :: [ZeroOneStar]
xs) = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (0a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [ZeroOneStar] -> [[a]]
substStars'' [ZeroOneStar]
xs
          substStars'' (One:xs :: [ZeroOneStar]
xs) = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [ZeroOneStar] -> [[a]]
substStars'' [ZeroOneStar]
xs
          substStars'' (Star:xs :: [ZeroOneStar]
xs) = [a
x'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs' | a
x' <- [a]
fq', [a]
xs' <- [ZeroOneStar] -> [[a]]
substStars'' [ZeroOneStar]
xs]
          substStars'' [] = [[]]

starSubstitutionsV :: [a] -> [ZeroOneStar] -> [[a]]
starSubstitutionsV fq' :: [a]
fq' (Zero:xs :: [ZeroOneStar]
xs) = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (0a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [ZeroOneStar] -> [[a]]
starSubstitutionsV [a]
fq' [ZeroOneStar]
xs
starSubstitutionsV fq' :: [a]
fq' (One:xs :: [ZeroOneStar]
xs) = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [ZeroOneStar] -> [[a]]
starSubstitutionsV [a]
fq' [ZeroOneStar]
xs
starSubstitutionsV fq' :: [a]
fq' (Star:xs :: [ZeroOneStar]
xs) = [a
x'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs' | a
x' <- [a]
fq', [a]
xs' <- [a] -> [ZeroOneStar] -> [[a]]
starSubstitutionsV [a]
fq' [ZeroOneStar]
xs]
starSubstitutionsV _ [] = [[]]


-- Oxley p184-5
-- Note that the particular representations you get depend on which basis is used
-- (Perhaps we should let you pass in the basis to use)
representations1 :: [a] -> Matroid a -> [[[a]]]
representations1 fq :: [a]
fq m :: Matroid a
m = [ [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
L.transpose [[a]]
d | [[a]]
d <- [[ZeroOneStar]] -> [a] -> [[[a]]]
forall a. Num a => [[ZeroOneStar]] -> [a] -> [[[a]]]
substStars [[ZeroOneStar]]
dhash [a]
fq, let mx :: [[a]]
mx = [[a]]
forall a. Num a => [[a]]
ir [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
d,
                                          Matroid a -> Matroid Int
forall a. Ord a => Matroid a -> Matroid Int
to1n Matroid a
m Matroid Int -> Matroid Int -> Bool
forall a. Eq a => a -> a -> Bool
== ([[a]] -> Matroid Int
forall k. (Eq k, Fractional k) => [[k]] -> Matroid Int
vectorMatroid' ([[a]] -> Matroid Int) -> [[a]] -> Matroid Int
forall a b. (a -> b) -> a -> b
$ ((a, [a]) -> [a]) -> [(a, [a])] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a, [a]) -> [a]
forall a b. (a, b) -> b
snd ([(a, [a])] -> [[a]]) -> [(a, [a])] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [(a, [a])] -> [(a, [a])]
forall a. Ord a => [a] -> [a]
L.sort ([(a, [a])] -> [(a, [a])]) -> [(a, [a])] -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]] -> [(a, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a]
b [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
b') [[a]]
mx) ]
    where b :: [a]
b = [[a]] -> [a]
forall a. [a] -> a
head ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid a
m
          b' :: [a]
b' = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b
          r :: Int
r = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
b -- rank of the matroid
          ir :: [[a]]
ir = Int -> [[a]]
forall a. Num a => Int -> [[a]]
idMx Int
r -- identity matrix
          dhash :: [[ZeroOneStar]]
dhash = [[Integer]] -> [[ZeroOneStar]]
forall a. (Eq a, Num a) => [[a]] -> [[ZeroOneStar]]
markNonInitialRCs ([[Integer]] -> [[ZeroOneStar]]) -> [[Integer]] -> [[ZeroOneStar]]
forall a b. (a -> b) -> a -> b
$ Matroid a -> [a] -> [[Integer]]
forall a a. (Ord a, Num a) => Matroid a -> [a] -> [[a]]
fcim' Matroid a
m [a]
b

-- edges of the fundamental circuit incidence graph
fcig :: Matroid a -> [a] -> [[a]]
fcig m :: Matroid a
m b :: [a]
b = [ [a
e,a
e'] | a
e <- [a]
b, a
e' <- Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b, a
e a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Matroid a -> [a] -> a -> [a]
forall a. Ord a => Matroid a -> [a] -> a -> [a]
fundamentalCircuit Matroid a
m [a]
b a
e' ]

-- the fcim of m relative to b, with 1s and *s marked
markedfcim :: Matroid a -> [a] -> [[ZeroOneStar]]
markedfcim m :: Matroid a
m b :: [a]
b = [a] -> [a] -> [[Integer]] -> [[ZeroOneStar]]
forall a. (Num a, Eq a) => [a] -> [a] -> [[a]] -> [[ZeroOneStar]]
mark [a]
b [a]
b' (Matroid a -> [a] -> [[Integer]]
forall a a. (Ord a, Num a) => Matroid a -> [a] -> [[a]]
fcim Matroid a
m [a]
b)
    where b' :: [a]
b' = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b -- the elements of b are the row labels, those of b' are the column labels
          entries :: [[a]]
entries = Matroid a -> [a] -> [[a]]
forall a. Ord a => Matroid a -> [a] -> [[a]]
fcig Matroid a
m [a]
b -- the [row,column] coordinates of the non-zero entries in the fcim
          ones :: [[a]]
ones = [[[a]]] -> [[a]]
forall a. [a] -> a
head ([[[a]]] -> [[a]]) -> [[[a]]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ Matroid [a] -> [[[a]]]
forall a. Ord a => Matroid a -> [[a]]
bases (Matroid [a] -> [[[a]]]) -> Matroid [a] -> [[[a]]]
forall a b. (a -> b) -> a -> b
$ [[a]] -> Matroid [a]
forall a. Ord a => [[a]] -> Matroid [a]
cycleMatroid' [[a]]
entries -- a set of entries which we can take to be 1
          stars :: [[a]]
stars = [[a]]
entries [[a]] -> [[a]] -> [[a]]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [[a]]
ones -- the set of entries which we are then still free to assign
          mark :: [a] -> [a] -> [[a]] -> [[ZeroOneStar]]
mark (i :: a
i:is :: [a]
is) js :: [a]
js (r :: [a]
r:rs :: [[a]]
rs) = (a -> [a] -> [a] -> [ZeroOneStar]
forall a. (Num a, Eq a) => a -> [a] -> [a] -> [ZeroOneStar]
mark' a
i [a]
js [a]
r) [ZeroOneStar] -> [[ZeroOneStar]] -> [[ZeroOneStar]]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [[a]] -> [[ZeroOneStar]]
mark [a]
is [a]
js [[a]]
rs
          mark [] _ [] = []
          mark' :: a -> [a] -> [a] -> [ZeroOneStar]
mark' i :: a
i (j :: a
j:js :: [a]
js) (x :: a
x:xs :: [a]
xs)
              | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ZeroOneStar
Zero ZeroOneStar -> [ZeroOneStar] -> [ZeroOneStar]
forall a. a -> [a] -> [a]
: a -> [a] -> [a] -> [ZeroOneStar]
mark' a
i [a]
js [a]
xs
              | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = (if [a
i,a
j] [a] -> [[a]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[a]]
stars then ZeroOneStar
Star else ZeroOneStar
One) ZeroOneStar -> [ZeroOneStar] -> [ZeroOneStar]
forall a. a -> [a] -> [a]
: a -> [a] -> [a] -> [ZeroOneStar]
mark' a
i [a]
js [a]
xs
          mark' _ [] [] = []
-- The markedfcim will sometimes do better than markNonInitialRCs, and is best possible

-- Oxley p184-5
representations2 :: [a] -> Matroid a -> [[[a]]]
representations2 fq :: [a]
fq m :: Matroid a
m = [ [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
L.transpose [[a]]
mx | [[a]]
d <- [[ZeroOneStar]] -> [a] -> [[[a]]]
forall a. Num a => [[ZeroOneStar]] -> [a] -> [[[a]]]
substStars [[ZeroOneStar]]
dhash' [a]
fq, let mx :: [[a]]
mx = [[a]]
forall a. Num a => [[a]]
ir [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
d,
                                           Matroid Int
m' Matroid Int -> Matroid Int -> Bool
forall a. Eq a => a -> a -> Bool
== ([[a]] -> Matroid Int
forall k. (Eq k, Fractional k) => [[k]] -> Matroid Int
vectorMatroid' ([[a]] -> Matroid Int) -> [[a]] -> Matroid Int
forall a b. (a -> b) -> a -> b
$ ((a, [a]) -> [a]) -> [(a, [a])] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a, [a]) -> [a]
forall a b. (a, b) -> b
snd ([(a, [a])] -> [[a]]) -> [(a, [a])] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [(a, [a])] -> [(a, [a])]
forall a. Ord a => [a] -> [a]
L.sort ([(a, [a])] -> [(a, [a])]) -> [(a, [a])] -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]] -> [(a, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a]
b [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
b') [[a]]
mx) ]
    where m' :: Matroid Int
m' = Matroid a -> Matroid Int
forall a. Ord a => Matroid a -> Matroid Int
to1n Matroid a
m
          es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
          b :: [a]
b = [[a]] -> [a]
forall a. [a] -> a
head ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid a
m
          b' :: [a]
b' = [a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b
          r :: Int
r = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
b -- rank of the matroid
          ir :: [[a]]
ir = Int -> [[a]]
forall a. Num a => Int -> [[a]]
idMx Int
r -- identity matrix
          dhash' :: [[ZeroOneStar]]
dhash' = [[ZeroOneStar]] -> [[ZeroOneStar]]
forall a. [[a]] -> [[a]]
L.transpose ([[ZeroOneStar]] -> [[ZeroOneStar]])
-> [[ZeroOneStar]] -> [[ZeroOneStar]]
forall a b. (a -> b) -> a -> b
$ Matroid a -> [a] -> [[ZeroOneStar]]
forall a. Ord a => Matroid a -> [a] -> [[ZeroOneStar]]
markedfcim Matroid a
m [a]
b

-- In the following, we check the representations of the restrictions as we add a column at a time
-- This enables us to early out if a potential representation doesn't work on a restriction

-- |Find representations of the matroid m over fq. Specifically, this function will find one representative
-- of each projective equivalence class of representation.
representations :: (Eq fq, Fractional fq, Ord a) => [fq] -> Matroid a -> [[[fq]]]
representations :: [fq] -> Matroid a -> [[[fq]]]
representations fq :: [fq]
fq m :: Matroid a
m = ([[fq]] -> [[fq]]) -> [[[fq]]] -> [[[fq]]]
forall a b. (a -> b) -> [a] -> [b]
map [[fq]] -> [[fq]]
forall a. [[a]] -> [[a]]
L.transpose ([[[fq]]] -> [[[fq]]]) -> [[[fq]]] -> [[[fq]]]
forall a b. (a -> b) -> a -> b
$ [(a, [fq])] -> [(a, [ZeroOneStar])] -> [[[fq]]]
representations' ([(a, [fq])] -> [(a, [fq])]
forall a. [a] -> [a]
reverse ([(a, [fq])] -> [(a, [fq])]) -> [(a, [fq])] -> [(a, [fq])]
forall a b. (a -> b) -> a -> b
$ [a] -> [[fq]] -> [(a, [fq])]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
b [[fq]]
forall a. Num a => [[a]]
ir) ([a] -> [[ZeroOneStar]] -> [(a, [ZeroOneStar])]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
b' [[ZeroOneStar]]
dhash')
    where fq' :: [fq]
fq' = [fq] -> [fq]
forall a. [a] -> [a]
tail [fq]
fq -- fq \ {0}
          b :: [a]
b = [[a]] -> [a]
forall a. [a] -> a
head ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid a
m
          b' :: [a]
b' = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
b
          r :: Int
r = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
b -- rank of the matroid
          ir :: [[a]]
ir = Int -> [[a]]
forall a. Num a => Int -> [[a]]
idMx Int
r -- identity matrix
          dhash' :: [[ZeroOneStar]]
dhash' = [[ZeroOneStar]] -> [[ZeroOneStar]]
forall a. [[a]] -> [[a]]
L.transpose ([[ZeroOneStar]] -> [[ZeroOneStar]])
-> [[ZeroOneStar]] -> [[ZeroOneStar]]
forall a b. (a -> b) -> a -> b
$ Matroid a -> [a] -> [[ZeroOneStar]]
forall a. Ord a => Matroid a -> [a] -> [[ZeroOneStar]]
markedfcim Matroid a
m [a]
b
          representations' :: [(a, [fq])] -> [(a, [ZeroOneStar])] -> [[[fq]]]
representations' ls :: [(a, [fq])]
ls ((i :: a
i,r :: [ZeroOneStar]
r):rs :: [(a, [ZeroOneStar])]
rs) = [[[[fq]]]] -> [[[fq]]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [(a, [fq])] -> [(a, [ZeroOneStar])] -> [[[fq]]]
representations' ((a
i,[fq]
r')(a, [fq]) -> [(a, [fq])] -> [(a, [fq])]
forall a. a -> [a] -> [a]
:[(a, [fq])]
ls) [(a, [ZeroOneStar])]
rs
              | [fq]
r' <- [fq] -> [ZeroOneStar] -> [[fq]]
forall a. Num a => [a] -> [ZeroOneStar] -> [[a]]
starSubstitutionsV [fq]
fq' [ZeroOneStar]
r,
                let (is :: [a]
is,vs :: [[fq]]
vs) = [(a, [fq])] -> ([a], [[fq]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(a, [fq])] -> ([a], [[fq]])) -> [(a, [fq])] -> ([a], [[fq]])
forall a b. (a -> b) -> a -> b
$ ((a, [fq]) -> (a, [fq]) -> Ordering) -> [(a, [fq])] -> [(a, [fq])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (a, [fq]) -> (a, [fq]) -> Ordering
forall a b1 b2. Ord a => (a, b1) -> (a, b2) -> Ordering
cmpfst ((a
i,[fq]
r')(a, [fq]) -> [(a, [fq])] -> [(a, [fq])]
forall a. a -> [a] -> [a]
:[(a, [fq])]
ls),
                Matroid a -> Matroid Int
forall a. Ord a => Matroid a -> Matroid Int
to1n (Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
restriction Matroid a
m [a]
is) Matroid Int -> Matroid Int -> Bool
forall a. Eq a => a -> a -> Bool
== ([[fq]] -> Matroid Int
forall k. (Eq k, Fractional k) => [[k]] -> Matroid Int
vectorMatroid' [[fq]]
vs) ]
          representations' ls :: [(a, [fq])]
ls [] = [((a, [fq]) -> [fq]) -> [(a, [fq])] -> [[fq]]
forall a b. (a -> b) -> [a] -> [b]
map (a, [fq]) -> [fq]
forall a b. (a, b) -> b
snd ([(a, [fq])] -> [[fq]]) -> [(a, [fq])] -> [[fq]]
forall a b. (a -> b) -> a -> b
$ [(a, [fq])] -> [(a, [fq])]
forall a. [a] -> [a]
reverse [(a, [fq])]
ls]

-- |Is the matroid representable over Fq? For example, to find out whether a matroid m is binary, evaluate @isRepresentable f2 m@.
isRepresentable :: (Eq fq, Fractional fq, Ord a) => [fq] -> Matroid a -> Bool
isRepresentable :: [fq] -> Matroid a -> Bool
isRepresentable fq :: [fq]
fq m :: Matroid a
m = (Bool -> Bool
not (Bool -> Bool) -> ([[[fq]]] -> Bool) -> [[[fq]]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[fq]]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([fq] -> Matroid a -> [[[fq]]]
forall fq a.
(Eq fq, Fractional fq, Ord a) =>
[fq] -> Matroid a -> [[[fq]]]
representations [fq]
fq Matroid a
m)

-- |A binary matroid is a matroid which is representable over F2
isBinary :: (Ord a) => Matroid a -> Bool
isBinary :: Matroid a -> Bool
isBinary = [F2] -> Matroid a -> Bool
forall fq a.
(Eq fq, Fractional fq, Ord a) =>
[fq] -> Matroid a -> Bool
isRepresentable [F2]
f2

-- |A ternary matroid is a matroid which is representable over F3
isTernary :: (Ord a) => Matroid a -> Bool
isTernary :: Matroid a -> Bool
isTernary = [F3] -> Matroid a -> Bool
forall fq a.
(Eq fq, Fractional fq, Ord a) =>
[fq] -> Matroid a -> Bool
isRepresentable [F3]
f3


-- CONSTRUCTIONS
-- The next three functions not very thoroughly tested

data LMR a b = L a | Mid | R b deriving (LMR a b -> LMR a b -> Bool
(LMR a b -> LMR a b -> Bool)
-> (LMR a b -> LMR a b -> Bool) -> Eq (LMR a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => LMR a b -> LMR a b -> Bool
/= :: LMR a b -> LMR a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => LMR a b -> LMR a b -> Bool
== :: LMR a b -> LMR a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => LMR a b -> LMR a b -> Bool
Eq, Eq (LMR a b)
Eq (LMR a b) =>
(LMR a b -> LMR a b -> Ordering)
-> (LMR a b -> LMR a b -> Bool)
-> (LMR a b -> LMR a b -> Bool)
-> (LMR a b -> LMR a b -> Bool)
-> (LMR a b -> LMR a b -> Bool)
-> (LMR a b -> LMR a b -> LMR a b)
-> (LMR a b -> LMR a b -> LMR a b)
-> Ord (LMR a b)
LMR a b -> LMR a b -> Bool
LMR a b -> LMR a b -> Ordering
LMR a b -> LMR a b -> LMR a b
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 a b. (Ord a, Ord b) => Eq (LMR a b)
forall a b. (Ord a, Ord b) => LMR a b -> LMR a b -> Bool
forall a b. (Ord a, Ord b) => LMR a b -> LMR a b -> Ordering
forall a b. (Ord a, Ord b) => LMR a b -> LMR a b -> LMR a b
min :: LMR a b -> LMR a b -> LMR a b
$cmin :: forall a b. (Ord a, Ord b) => LMR a b -> LMR a b -> LMR a b
max :: LMR a b -> LMR a b -> LMR a b
$cmax :: forall a b. (Ord a, Ord b) => LMR a b -> LMR a b -> LMR a b
>= :: LMR a b -> LMR a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => LMR a b -> LMR a b -> Bool
> :: LMR a b -> LMR a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => LMR a b -> LMR a b -> Bool
<= :: LMR a b -> LMR a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => LMR a b -> LMR a b -> Bool
< :: LMR a b -> LMR a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => LMR a b -> LMR a b -> Bool
compare :: LMR a b -> LMR a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => LMR a b -> LMR a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (LMR a b)
Ord, Int -> LMR a b -> [Char] -> [Char]
[LMR a b] -> [Char] -> [Char]
LMR a b -> [Char]
(Int -> LMR a b -> [Char] -> [Char])
-> (LMR a b -> [Char])
-> ([LMR a b] -> [Char] -> [Char])
-> Show (LMR a b)
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
forall a b. (Show a, Show b) => Int -> LMR a b -> [Char] -> [Char]
forall a b. (Show a, Show b) => [LMR a b] -> [Char] -> [Char]
forall a b. (Show a, Show b) => LMR a b -> [Char]
showList :: [LMR a b] -> [Char] -> [Char]
$cshowList :: forall a b. (Show a, Show b) => [LMR a b] -> [Char] -> [Char]
show :: LMR a b -> [Char]
$cshow :: forall a b. (Show a, Show b) => LMR a b -> [Char]
showsPrec :: Int -> LMR a b -> [Char] -> [Char]
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> LMR a b -> [Char] -> [Char]
Show)

-- Oxley p252
seriesConnection :: (Matroid a, a) -> (Matroid a, a) -> Matroid (LMR a a)
seriesConnection (m1 :: Matroid a
m1,p1 :: a
p1) (m2 :: Matroid a
m2,p2 :: a
p2)
    | Bool -> Bool
not (Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isLoop Matroid a
m1 a
p1) Bool -> Bool -> Bool
&& Bool -> Bool
not (Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isColoop Matroid a
m1 a
p1) Bool -> Bool -> Bool
&& Bool -> Bool
not (Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isLoop Matroid a
m2 a
p2) Bool -> Bool -> Bool
&& Bool -> Bool
not (Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isColoop Matroid a
m2 a
p2) =
        [LMR a a] -> [[LMR a a]] -> Matroid (LMR a a)
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromCircuits [LMR a a]
es [[LMR a a]]
cs
    | Bool
otherwise = [Char] -> Matroid (LMR a a)
forall a. HasCallStack => [Char] -> a
error "not yet implemented"
        where es :: [LMR a a]
es = (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. a -> LMR a b
L (Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m1 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a
p1]) [LMR a a] -> [LMR a a] -> [LMR a a]
forall a. [a] -> [a] -> [a]
++ [LMR a a
forall a b. LMR a b
Mid] [LMR a a] -> [LMR a a] -> [LMR a a]
forall a. [a] -> [a] -> [a]
++ (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. b -> LMR a b
R (Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m2 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a
p2])
              cs :: [[LMR a a]]
cs = (([a] -> [LMR a a]) -> [[a]] -> [[LMR a a]]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [LMR a a]) -> [[a]] -> [[LMR a a]])
-> ((a -> LMR a a) -> [a] -> [LMR a a])
-> (a -> LMR a a)
-> [[a]]
-> [[LMR a a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map) a -> LMR a a
forall a b. a -> LMR a b
L (Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits (Matroid a -> [[a]]) -> Matroid a -> [[a]]
forall a b. (a -> b) -> a -> b
$ Matroid a
m1 Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
\\\ [a
p1]) [[LMR a a]] -> [[LMR a a]] -> [[LMR a a]]
forall a. [a] -> [a] -> [a]
++
                   (([a] -> [LMR a a]) -> [[a]] -> [[LMR a a]]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [LMR a a]) -> [[a]] -> [[LMR a a]])
-> ((a -> LMR a a) -> [a] -> [LMR a a])
-> (a -> LMR a a)
-> [[a]]
-> [[LMR a a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map) a -> LMR a a
forall a b. b -> LMR a b
R (Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits (Matroid a -> [[a]]) -> Matroid a -> [[a]]
forall a b. (a -> b) -> a -> b
$ Matroid a
m2 Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
\\\ [a
p2]) [[LMR a a]] -> [[LMR a a]] -> [[LMR a a]]
forall a. [a] -> [a] -> [a]
++
                   [ (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. a -> LMR a b
L (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
p1 [a]
c1) [LMR a a] -> [LMR a a] -> [LMR a a]
forall a. [a] -> [a] -> [a]
++ [LMR a a
forall a b. LMR a b
Mid] [LMR a a] -> [LMR a a] -> [LMR a a]
forall a. [a] -> [a] -> [a]
++ (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. b -> LMR a b
R (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
p2 [a]
c2)
                   | [a]
c1 <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m1, a
p1 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
c1, [a]
c2 <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m2, a
p2 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
c2]

parallelConnection :: (Matroid a, a) -> (Matroid a, a) -> Matroid (LMR a a)
parallelConnection (m1 :: Matroid a
m1,p1 :: a
p1) (m2 :: Matroid a
m2,p2 :: a
p2)
    | Bool -> Bool
not (Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isLoop Matroid a
m1 a
p1) Bool -> Bool -> Bool
&& Bool -> Bool
not (Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isColoop Matroid a
m1 a
p1) Bool -> Bool -> Bool
&& Bool -> Bool
not (Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isLoop Matroid a
m2 a
p2) Bool -> Bool -> Bool
&& Bool -> Bool
not (Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isColoop Matroid a
m2 a
p2) =
        [LMR a a] -> [[LMR a a]] -> Matroid (LMR a a)
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromCircuits [LMR a a]
es [[LMR a a]]
cs
    | Bool
otherwise = [Char] -> Matroid (LMR a a)
forall a. HasCallStack => [Char] -> a
error "not yet implemented"
        where es :: [LMR a a]
es = (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. a -> LMR a b
L (Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m1 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a
p1]) [LMR a a] -> [LMR a a] -> [LMR a a]
forall a. [a] -> [a] -> [a]
++ [LMR a a
forall a b. LMR a b
Mid] [LMR a a] -> [LMR a a] -> [LMR a a]
forall a. [a] -> [a] -> [a]
++ (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. b -> LMR a b
R (Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m2 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a
p2])
              cs :: [[LMR a a]]
cs = (([a] -> [LMR a a]) -> [[a]] -> [[LMR a a]]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [LMR a a]) -> [[a]] -> [[LMR a a]])
-> ((a -> LMR a a) -> [a] -> [LMR a a])
-> (a -> LMR a a)
-> [[a]]
-> [[LMR a a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map) a -> LMR a a
forall a b. a -> LMR a b
L (Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits (Matroid a -> [[a]]) -> Matroid a -> [[a]]
forall a b. (a -> b) -> a -> b
$ Matroid a
m1 Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
\\\ [a
p1]) [[LMR a a]] -> [[LMR a a]] -> [[LMR a a]]
forall a. [a] -> [a] -> [a]
++
                   [ (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. a -> LMR a b
L (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
p1 [a]
c1) [LMR a a] -> [LMR a a] -> [LMR a a]
forall a. [a] -> [a] -> [a]
++ [LMR a a
forall a b. LMR a b
Mid] | [a]
c1 <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m1, a
p1 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
c1 ] [[LMR a a]] -> [[LMR a a]] -> [[LMR a a]]
forall a. [a] -> [a] -> [a]
++
                   (([a] -> [LMR a a]) -> [[a]] -> [[LMR a a]]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [LMR a a]) -> [[a]] -> [[LMR a a]])
-> ((a -> LMR a a) -> [a] -> [LMR a a])
-> (a -> LMR a a)
-> [[a]]
-> [[LMR a a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map) a -> LMR a a
forall a b. b -> LMR a b
R (Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits (Matroid a -> [[a]]) -> Matroid a -> [[a]]
forall a b. (a -> b) -> a -> b
$ Matroid a
m2 Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
\\\ [a
p2]) [[LMR a a]] -> [[LMR a a]] -> [[LMR a a]]
forall a. [a] -> [a] -> [a]
++
                   [ [LMR a a
forall a b. LMR a b
Mid] [LMR a a] -> [LMR a a] -> [LMR a a]
forall a. [a] -> [a] -> [a]
++ (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. b -> LMR a b
R (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
p2 [a]
c2) | [a]
c2 <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m2, a
p2 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
c2 ] [[LMR a a]] -> [[LMR a a]] -> [[LMR a a]]
forall a. [a] -> [a] -> [a]
++
                   [ (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. a -> LMR a b
L (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
p1 [a]
c1) [LMR a a] -> [LMR a a] -> [LMR a a]
forall a. [a] -> [a] -> [a]
++ (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. b -> LMR a b
R (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
p2 [a]
c2)
                   | [a]
c1 <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m1, a
p1 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
c1, [a]
c2 <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m2, a
p2 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
c2 ]

twoSum :: (Matroid a, a) -> (Matroid a, a) -> Matroid (LMR a a)
twoSum (m1 :: Matroid a
m1,p1 :: a
p1) (m2 :: Matroid a
m2,p2 :: a
p2)
    | Bool -> Bool
not (Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isLoop Matroid a
m1 a
p1) Bool -> Bool -> Bool
&& Bool -> Bool
not (Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isColoop Matroid a
m1 a
p1) Bool -> Bool -> Bool
&& Bool -> Bool
not (Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isLoop Matroid a
m2 a
p2) Bool -> Bool -> Bool
&& Bool -> Bool
not (Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isColoop Matroid a
m2 a
p2) =
        [LMR a a] -> [[LMR a a]] -> Matroid (LMR a a)
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromCircuits [LMR a a]
es [[LMR a a]]
cs
    | Bool
otherwise = [Char] -> Matroid (LMR a a)
forall a. HasCallStack => [Char] -> a
error "not yet implemented"
        where es :: [LMR a a]
es = (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. a -> LMR a b
L (Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m1 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a
p1]) [LMR a a] -> [LMR a a] -> [LMR a a]
forall a. [a] -> [a] -> [a]
++ [LMR a a
forall a b. LMR a b
Mid] [LMR a a] -> [LMR a a] -> [LMR a a]
forall a. [a] -> [a] -> [a]
++ (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. b -> LMR a b
R (Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m2 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a
p2])
              cs :: [[LMR a a]]
cs = (([a] -> [LMR a a]) -> [[a]] -> [[LMR a a]]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [LMR a a]) -> [[a]] -> [[LMR a a]])
-> ((a -> LMR a a) -> [a] -> [LMR a a])
-> (a -> LMR a a)
-> [[a]]
-> [[LMR a a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map) a -> LMR a a
forall a b. a -> LMR a b
L (Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits (Matroid a -> [[a]]) -> Matroid a -> [[a]]
forall a b. (a -> b) -> a -> b
$ Matroid a
m1 Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
\\\ [a
p1]) [[LMR a a]] -> [[LMR a a]] -> [[LMR a a]]
forall a. [a] -> [a] -> [a]
++
                   (([a] -> [LMR a a]) -> [[a]] -> [[LMR a a]]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [LMR a a]) -> [[a]] -> [[LMR a a]])
-> ((a -> LMR a a) -> [a] -> [LMR a a])
-> (a -> LMR a a)
-> [[a]]
-> [[LMR a a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map) a -> LMR a a
forall a b. b -> LMR a b
R (Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits (Matroid a -> [[a]]) -> Matroid a -> [[a]]
forall a b. (a -> b) -> a -> b
$ Matroid a
m2 Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
\\\ [a
p2]) [[LMR a a]] -> [[LMR a a]] -> [[LMR a a]]
forall a. [a] -> [a] -> [a]
++
                   [ (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. a -> LMR a b
L (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
p1 [a]
c1) [LMR a a] -> [LMR a a] -> [LMR a a]
forall a. [a] -> [a] -> [a]
++ (a -> LMR a a) -> [a] -> [LMR a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LMR a a
forall a b. b -> LMR a b
R (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
p2 [a]
c2)
                   | [a]
c1 <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m1, a
p1 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
c1, [a]
c2 <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m2, a
p2 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
c2]
-- Note: The only different from seriesConnection is that we don't have Mid in the last set

-- Oxley p427
matroidUnion :: Matroid a -> Matroid a -> Matroid a
matroidUnion m1 :: Matroid a
m1 m2 :: Matroid a
m2 = [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromBases [a]
es [[a]]
bs
    where es :: [a]
es = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.union (Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m1) (Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m2)
          is :: [[a]]
is = [[a]] -> [[a]]
forall (t :: * -> *) a. (Ord (t a), Foldable t) => [t a] -> [t a]
toShortlex ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]]
forall a. Ord a => [a] -> [a]
toSet [ [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.union [a]
b1 [a]
b2 | [a]
b1 <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid a
m1, [a]
b2 <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
bases Matroid a
m2 ]
          r :: Int
r = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall a. [a] -> a
last [[a]]
is
          bs :: [[a]]
bs = ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ( (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
r) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ) [[a]]
is



-- SOME INTERESTING MATROIDS

-- |The Fano plane F7 = PG(2,F2)
f7 :: Matroid Int
f7 :: Matroid Int
f7 = [[Int]] -> [[Int]] -> [[Int]] -> [[Int]] -> Matroid Int
forall a. Ord a => [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
fromGeoRep [] [] [[1,2,3],[1,4,7],[1,5,6],[2,4,6],[2,5,7],[3,4,5],[3,6,7]] [[1..7]]

-- Oxley p36, fig 1.12:
-- cycleMatroid [[1,2],[1,3],[2,3],[3,4],[2,4],[1,4]] == restriction fanoPlane [1..6]

-- |F7-, the relaxation of the Fano plane by removal of a line
f7m :: Matroid Int
f7m :: Matroid Int
f7m = Matroid Int -> [Int] -> Matroid Int
forall a. Ord a => Matroid a -> [a] -> Matroid a
relaxation Matroid Int
f7 [2,4,6]

-- Oxley p39
-- |The Pappus configuration from projective geometry
pappus :: Matroid Int
pappus :: Matroid Int
pappus = [[Int]] -> [[Int]] -> [[Int]] -> [[Int]] -> Matroid Int
forall a. Ord a => [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
fromGeoRep [] [] [[1,2,3],[1,5,7],[1,6,8],[2,4,7],[2,6,9],[3,4,8],[3,5,9],[4,5,6],[7,8,9]] [[1..9]]

-- more logical relabeling
-- pappus' = fromGeoRep [] [] [[1,2,3],[1,5,9],[1,6,8],[2,4,9],[2,6,7],[3,4,8],[3,5,7],[4,5,6],[7,8,9]] [[1..9]]

-- |Relaxation of the Pappus configuration by removal of a line
nonPappus :: Matroid Int
nonPappus :: Matroid Int
nonPappus = Matroid Int -> [Int] -> Matroid Int
forall a. Ord a => Matroid a -> [a] -> Matroid a
relaxation Matroid Int
pappus [7,8,9]
-- fromGeoRep [] [] [[1,2,3],[1,5,7],[1,6,8],[2,4,7],[2,6,9],[3,4,8],[3,5,9],[4,5,6]] [[1..9]]

-- |The Desargues configuration
desargues :: Matroid Int
desargues :: Matroid Int
desargues = [[Int]] -> [[Int]] -> [[Int]] -> [[Int]] -> Matroid Int
forall a. Ord a => [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
fromGeoRep [] [] [[1,2,5],[1,3,6],[1,4,7],[2,3,8],[2,4,9],[3,4,10],[5,6,8],[5,7,9],[6,7,10],[8,9,10]]
                              [[1,2,3,5,6,8],[1,2,4,5,7,9],[1,3,4,6,7,10],[2,3,4,8,9,10],[5,6,7,8,9,10]]
-- desargues == cycleMatroid (combinationsOf 2 [1..5])
-- (ie Desargues = M(K5) )
-- interestingly, although these are all the dependent flats that are evident from the diagram,
-- there are also some rank 3 flats consisting of a line and an "antipodal" point
-- eg, in terms of K5, [1,8,9,10] corresponds to [[1,2],[3,4],[3,5],[4,5]]

-- Oxley p71
vamosMatroid1 :: Matroid a
vamosMatroid1 = [a] -> [[a]] -> Matroid a
forall a. Ord a => [a] -> [[a]] -> Matroid a
fromHyperplanes [1..8] ([[a]]
forall a. Num a => [[a]]
hs4 [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
forall a. (Num a, Enum a, Ord a) => [[a]]
hs3)
    where hs4 :: [[a]]
hs4 = [ [1,2,3,4], [1,4,5,6], [2,3,5,6], [1,4,7,8], [2,3,7,8] ]
          hs3 :: [[a]]
hs3 = [ [a]
h3 | [a]
h3 <- Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinationsOf 3 [1..8], [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]
h4 | [a]
h4 <- [[a]]
forall a. Num a => [[a]]
hs4, [a]
h3 [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`LS.isSubset` [a]
h4] ]
vamosMatroid :: Matroid a
vamosMatroid = [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
forall a. Ord a => [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
fromGeoRep [] [] [] [[1,2,3,4],[1,4,5,6],[2,3,5,6],[1,4,7,8],[2,3,7,8]]

-- |The Vamos matroid V8. It is not representable over any field.
v8 :: Matroid Int
v8 :: Matroid Int
v8 = Matroid Int
forall a. (Ord a, Num a) => Matroid a
vamosMatroid
-- v8 is self-dual (isomorphic to its own dual)

-- Oxley p188
-- |P8 is a minor-minimal matroid that is not representable over F4, F8, F16, ... .
-- It is Fq-representable if and only if q is not a power of 2.
p8 :: Matroid Int
p8 :: Matroid Int
p8 = [[F3]] -> Matroid Int
forall k. (Eq k, Fractional k) => [[k]] -> Matroid Int
vectorMatroid ([[F3]] -> Matroid Int) -> [[F3]] -> Matroid Int
forall a b. (a -> b) -> a -> b
$
    ( [ [1,0,0,0,  0, 1, 1,-1],
        [0,1,0,0,  1, 0, 1, 1],
        [0,0,1,0,  1, 1, 0, 1],
        [0,0,0,1, -1, 1, 1, 0] ] :: [[F3]] )

p8' :: Matroid a
p8' = [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
forall a. Ord a => [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
fromGeoRep [] [] [] [ [1,2,3,8], [1,2,4,7], [1,3,4,6], [1,4,5,8], [1,5,6,7], [2,3,4,5], [2,3,6,7], [2,5,6,8], [3,5,7,8], [4,6,7,8] ]

-- |P8- is a relaxation of P8. It is Fq-representable if and only if q >= 4.
p8m :: Matroid Int
p8m :: Matroid Int
p8m = Matroid Int -> [Int] -> Matroid Int
forall a. Ord a => Matroid a -> [a] -> Matroid a
relaxation Matroid Int
p8 [2,3,6,7]

-- |P8-- is a relaxation of P8-. It is a minor-minimal matroid that is not representable over F4.
-- It is Fq-representable if and only if q >= 5.
p8mm :: Matroid Int
p8mm :: Matroid Int
p8mm = Matroid Int -> [Int] -> Matroid Int
forall a. Ord a => Matroid a -> [a] -> Matroid a
relaxation Matroid Int
p8m [1,4,5,8]


-- Oxley p317
-- r-spoked wheel graph
wheelGraph :: a -> Graph a
wheelGraph r :: a
r = [a] -> [[a]] -> Graph a
forall a. [a] -> [[a]] -> Graph a
G.G [a]
vs [[a]]
es
    where vs :: [a]
vs = [0..a
r]
          es :: [[a]]
es = [ [0,a
i] | a
i <- [1..a
r] ] [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [ [a
i,a
ia -> a -> a
forall a. Num a => a -> a -> a
+1] | a
i <- [1..a
ra -> a -> a
forall a. Num a => a -> a -> a
-1] ] [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [ [1,a
r] ]
-- for normal form, should L.sort es

mw4 :: Matroid Int
mw4 = [[Integer]] -> Matroid Int
forall a. Ord a => [[a]] -> Matroid Int
cycleMatroid ([[Integer]] -> Matroid Int) -> [[Integer]] -> Matroid Int
forall a b. (a -> b) -> a -> b
$ Graph Integer -> [[Integer]]
forall a. Graph a -> [[a]]
G.edges (Graph Integer -> [[Integer]]) -> Graph Integer -> [[Integer]]
forall a b. (a -> b) -> a -> b
$ Integer -> Graph Integer
forall a. (Num a, Enum a) => a -> Graph a
wheelGraph 4
-- has [5,6,7,8] as unique circuit-hyperplane

w4' :: Matroid Int
w4' = Matroid Int -> [Int] -> Matroid Int
forall a. Ord a => Matroid a -> [a] -> Matroid a
relaxation Matroid Int
mw4 ([Int] -> Matroid Int) -> [Int] -> Matroid Int
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [Int]
forall a. [a] -> a
unique ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ Matroid Int -> [[Int]]
forall a. Ord a => Matroid a -> [[a]]
circuitHyperplanes Matroid Int
mw4 -- [5,6,7,8]

-- Oxley p183
w4 :: Matroid a
w4 = [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
forall a. Ord a => [[a]] -> [[a]] -> [[a]] -> [[a]] -> Matroid a
fromGeoRep [] [] [[1,2,5],[1,4,8],[2,3,6],[3,4,7]] [[1,2,3,5,6],[1,2,4,5,8],[1,3,4,7,8],[2,3,4,6,7]]


-- BINARY MATROIDS

-- Oxley p344
isBinary2 :: Matroid a -> Bool
isBinary2 m :: Matroid a
m = ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Bool
forall a. Integral a => a -> Bool
even (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [ [a]
c [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`LS.intersect` [a]
cc | [a]
c <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
circuits Matroid a
m, [a]
cc <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
cocircuits Matroid a
m ]


-- RANK POLYNOMIAL
-- Godsil & Royle p356

[x :: GlexPoly Integer [Char]
x,y :: GlexPoly Integer [Char]
y] = ([Char] -> GlexPoly Integer [Char])
-> [[Char]] -> [GlexPoly Integer [Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> GlexPoly Integer [Char]
forall k v. Num k => v -> GlexPoly k v
glexVar ["x","y"] :: [GlexPoly Integer String]

-- first naive version
rankPoly1 :: Matroid a -> GlexPoly Integer [Char]
rankPoly1 m :: Matroid a
m = [GlexPoly Integer [Char]] -> GlexPoly Integer [Char]
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ GlexPoly Integer [Char]
xGlexPoly Integer [Char] -> Int -> GlexPoly Integer [Char]
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
rm Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
r [a]
a) GlexPoly Integer [Char]
-> GlexPoly Integer [Char] -> GlexPoly Integer [Char]
forall a. Num a => a -> a -> a
* GlexPoly Integer [Char]
yGlexPoly Integer [Char] -> Int -> GlexPoly Integer [Char]
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
rm' Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
r' [a]
a') | [a]
a <- [a] -> [[a]]
forall a. [a] -> [[a]]
powersetdfs [a]
es, let a' :: [a]
a' = [a]
es [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
a ]
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
          rm :: Int
rm = Matroid a -> Int
forall a. Ord a => Matroid a -> Int
rank Matroid a
m
          r :: [a] -> Int
r = Matroid a -> [a] -> Int
forall a. Ord a => Matroid a -> [a] -> Int
rankfun Matroid a
m
          m' :: Matroid a
m' = Matroid a -> Matroid a
forall a. Ord a => Matroid a -> Matroid a
dual Matroid a
m
          rm' :: Int
rm' = Matroid a -> Int
forall a. Ord a => Matroid a -> Int
rank Matroid a
m'
          r' :: [a] -> Int
r' = Matroid a -> [a] -> Int
forall a. Ord a => Matroid a -> [a] -> Int
rankfun Matroid a
m'

-- |Given a matroid m over elements es, the rank polynomial is a polynomial r(x,y),
-- which is essentially a generating function for the subsets of es, enumerated by size and rank.
-- It is efficiently calculated using deletion and contraction.
--
-- It has the property that r(0,0) is the number of bases in m, r(1,0) is the number of independent sets,
-- r(0,1) is the number of spanning sets. It can also be used to derive the chromatic polynomial of a graph,
-- the weight enumerator of a linear code, and more.
rankPoly :: (Ord a) => Matroid a -> GlexPoly Integer String
rankPoly :: Matroid a -> GlexPoly Integer [Char]
rankPoly m :: Matroid a
m
    | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
es = 1
    | Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isLoop Matroid a
m a
e = (1GlexPoly Integer [Char]
-> GlexPoly Integer [Char] -> GlexPoly Integer [Char]
forall a. Num a => a -> a -> a
+GlexPoly Integer [Char]
y) GlexPoly Integer [Char]
-> GlexPoly Integer [Char] -> GlexPoly Integer [Char]
forall a. Num a => a -> a -> a
* Matroid a -> GlexPoly Integer [Char]
forall a. Ord a => Matroid a -> GlexPoly Integer [Char]
rankPoly (Matroid a
m Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
\\\ [a
e]) -- deletion
    | Matroid a -> a -> Bool
forall a. Ord a => Matroid a -> a -> Bool
isColoop Matroid a
m a
e = (1GlexPoly Integer [Char]
-> GlexPoly Integer [Char] -> GlexPoly Integer [Char]
forall a. Num a => a -> a -> a
+GlexPoly Integer [Char]
x) GlexPoly Integer [Char]
-> GlexPoly Integer [Char] -> GlexPoly Integer [Char]
forall a. Num a => a -> a -> a
* Matroid a -> GlexPoly Integer [Char]
forall a. Ord a => Matroid a -> GlexPoly Integer [Char]
rankPoly (Matroid a
m Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
/// [a
e]) -- contraction
    | Bool
otherwise = Matroid a -> GlexPoly Integer [Char]
forall a. Ord a => Matroid a -> GlexPoly Integer [Char]
rankPoly (Matroid a
m Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
\\\ [a
e]) GlexPoly Integer [Char]
-> GlexPoly Integer [Char] -> GlexPoly Integer [Char]
forall a. Num a => a -> a -> a
+ Matroid a -> GlexPoly Integer [Char]
forall a. Ord a => Matroid a -> GlexPoly Integer [Char]
rankPoly (Matroid a
m Matroid a -> [a] -> Matroid a
forall a. Ord a => Matroid a -> [a] -> Matroid a
/// [a
e])
    where es :: [a]
es = Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m
          e :: a
e = [a] -> a
forall a. [a] -> a
head [a]
es

numBases :: Matroid a -> Integer
numBases m :: Matroid a
m = Vect Integer () -> Integer
forall k. Num k => Vect k () -> k
unwrap (Vect Integer () -> Integer) -> Vect Integer () -> Integer
forall a b. (a -> b) -> a -> b
$ Matroid a -> GlexPoly Integer [Char]
forall a. Ord a => Matroid a -> GlexPoly Integer [Char]
rankPoly Matroid a
m GlexPoly Integer [Char]
-> ([Char] -> Vect Integer ()) -> Vect Integer ()
forall (m :: * -> *) k b v.
(Monomial m, Eq k, Num k, Ord b, Show b, Algebra k b) =>
Vect k (m v) -> (v -> Vect k b) -> Vect k b
`bind` (\v :: [Char]
v -> case [Char]
v of "x" -> 0; "y" -> 0)

numIndeps :: Matroid a -> Integer
numIndeps m :: Matroid a
m = Vect Integer () -> Integer
forall k. Num k => Vect k () -> k
unwrap (Vect Integer () -> Integer) -> Vect Integer () -> Integer
forall a b. (a -> b) -> a -> b
$ Matroid a -> GlexPoly Integer [Char]
forall a. Ord a => Matroid a -> GlexPoly Integer [Char]
rankPoly Matroid a
m GlexPoly Integer [Char]
-> ([Char] -> Vect Integer ()) -> Vect Integer ()
forall (m :: * -> *) k b v.
(Monomial m, Eq k, Num k, Ord b, Show b, Algebra k b) =>
Vect k (m v) -> (v -> Vect k b) -> Vect k b
`bind` (\v :: [Char]
v -> case [Char]
v of "x" -> 1; "y" -> 0)

numSpanning :: Matroid a -> Integer
numSpanning m :: Matroid a
m = Vect Integer () -> Integer
forall k. Num k => Vect k () -> k
unwrap (Vect Integer () -> Integer) -> Vect Integer () -> Integer
forall a b. (a -> b) -> a -> b
$ Matroid a -> GlexPoly Integer [Char]
forall a. Ord a => Matroid a -> GlexPoly Integer [Char]
rankPoly Matroid a
m GlexPoly Integer [Char]
-> ([Char] -> Vect Integer ()) -> Vect Integer ()
forall (m :: * -> *) k b v.
(Monomial m, Eq k, Num k, Ord b, Show b, Algebra k b) =>
Vect k (m v) -> (v -> Vect k b) -> Vect k b
`bind` (\v :: [Char]
v -> case [Char]
v of "x" -> 0; "y" -> 1)

-- It is then possible to derive the chromatic poly of a graph from the rankPoly of its cycle matroid, etc


-- Oxley p586

-- How many independent sets are there of each size
indepCounts :: Matroid a -> [Int]
indepCounts m :: Matroid a
m = ([(Int, [a])] -> Int) -> [[(Int, [a])]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, [a])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[(Int, [a])]] -> [Int]) -> [[(Int, [a])]] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((Int, [a]) -> (Int, [a]) -> Bool)
-> [(Int, [a])] -> [[(Int, [a])]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (Int, [a]) -> (Int, [a]) -> Bool
forall a b1 b2. Eq a => (a, b1) -> (a, b2) -> Bool
eqfst ([(Int, [a])] -> [[(Int, [a])]]) -> [(Int, [a])] -> [[(Int, [a])]]
forall a b. (a -> b) -> a -> b
$ [([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
i, [a]
i) | [a]
i <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
indeps Matroid a
m]
-- relying on shortlex order

{-
-- The following tries to calculate the indep counts
-- as the Hilbert series of the Stanley-Reisner ring.
-- However, it's not giving the right answer.
indepCounts2 m = take r $ indepCounts' (circuits m)
    where n = length (elements m) -- the number of "variables"
          r = rank m
          n' = toInteger n
          indepCounts' [] = map (\k -> (k+n'-1) `choose` (n'-1)) [0..]
              -- the number of ways of choosing n-1 separators, so as to leave a product of k powers
          indepCounts' (c:cs) =
              let d = length c -- the "degree" of c
                  cs' = reduce [] $ toShortlex $ toSet $ map (LS.\\ c) cs -- the quotient of cs by c
              in indepCounts' cs <-> (replicate d 0 ++ indepCounts' cs')
          reduce ls (r:rs) = if any (`LS.isSubset` r) ls then reduce ls rs else reduce (r:ls) rs
          reduce ls [] = reverse ls
          (x:xs) <+> (y:ys) = (x+y) : (xs <+> ys)
          xs <+> ys = xs ++ ys -- one of them is null
          xs <-> ys = xs <+> map negate ys 
-}


-- Whitney numbers of the second kind
-- The number of flats of each rank
whitney2nd :: Matroid a -> [Int]
whitney2nd m :: Matroid a
m = ([(Int, [a])] -> Int) -> [[(Int, [a])]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, [a])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[(Int, [a])]] -> [Int]) -> [[(Int, [a])]] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((Int, [a]) -> (Int, [a]) -> Bool)
-> [(Int, [a])] -> [[(Int, [a])]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (Int, [a]) -> (Int, [a]) -> Bool
forall a b1 b2. Eq a => (a, b1) -> (a, b2) -> Bool
eqfst ([(Int, [a])] -> [[(Int, [a])]]) -> [(Int, [a])] -> [[(Int, [a])]]
forall a b. (a -> b) -> a -> b
$ [(Int, [a])] -> [(Int, [a])]
forall a. Ord a => [a] -> [a]
L.sort [(Matroid a -> [a] -> Int
forall a. Ord a => Matroid a -> [a] -> Int
rankfun Matroid a
m [a]
f, [a]
f) | [a]
f <- Matroid a -> [[a]]
forall a. Ord a => Matroid a -> [[a]]
flats Matroid a
m]

-- Whitney numbers of the first kind
-- The number of subsets (of the element set) of each rank
whitney1st :: Matroid a -> [Int]
whitney1st m :: Matroid a
m = [Int] -> [Int]
forall b. Num b => [b] -> [b]
alternatingSign ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ ([(Int, [a])] -> Int) -> [[(Int, [a])]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, [a])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[(Int, [a])]] -> [Int]) -> [[(Int, [a])]] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((Int, [a]) -> (Int, [a]) -> Bool)
-> [(Int, [a])] -> [[(Int, [a])]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (Int, [a]) -> (Int, [a]) -> Bool
forall a b1 b2. Eq a => (a, b1) -> (a, b2) -> Bool
eqfst ([(Int, [a])] -> [[(Int, [a])]]) -> [(Int, [a])] -> [[(Int, [a])]]
forall a b. (a -> b) -> a -> b
$ [(Int, [a])] -> [(Int, [a])]
forall a. Ord a => [a] -> [a]
L.sort [(Matroid a -> [a] -> Int
forall a. Ord a => Matroid a -> [a] -> Int
rankfun Matroid a
m [a]
x, [a]
x) | [a]
x <- [a] -> [[a]]
forall a. [a] -> [[a]]
powersetdfs (Matroid a -> [a]
forall t. Matroid t -> [t]
elements Matroid a
m)]
    where alternatingSign :: [b] -> [b]
alternatingSign (x :: b
x:xs :: [b]
xs) = b
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b] -> [b]
alternatingSign ((b -> b) -> [b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map b -> b
forall a. Num a => a -> a
negate [b]
xs)
          alternatingSign [] = []



-- TODO

-- 1. Sort out the isomorphism code in the case where the incidence graph isn't connected

-- 2. We could generate the geometric representation from a matroid (provided its rank <= 4)
-- geoRep m = filter (isDependent m) (flats m)

-- 3. isMatroidFlats