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

This module contains hspec test suites that check certain properties of the algorithms

-}

module Test.Matroid.Algorithms.Suites where

import Data.Matroid

import Data.Matroid.Algorithms.Enumerate
import Data.Matroid.Algorithms.Greedy

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

import Test.Matroid.Helpers
import Test.QuickCheck
import Test.Hspec

greedyOptimizationTestSuite :: (Matroid m a) => Gen (m a) {- ^ matroid test case generator -} -> SpecWith ()
greedyOptimizationTestSuite :: Gen (m a) -> SpecWith ()
greedyOptimizationTestSuite Gen (m a)
genMatroids = String -> SpecWith () -> SpecWith ()
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
context String
"greedy algorithm" (SpecWith () -> SpecWith ()) -> SpecWith () -> SpecWith ()
forall a b. (a -> b) -> a -> b
$ do
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Algorithms.greedy gives optimal basis" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ Gen Bool -> Property
forall prop. Testable prop => prop -> Property
property (Gen Bool -> Property) -> Gen Bool -> Property
forall a b. (a -> b) -> a -> b
$ do
      m a
m <- Gen (m a)
genMatroids
      [a]
e <- [a] -> Gen [a]
forall a. [a] -> Gen [a]
shuffle ([a] -> Gen [a]) -> [a] -> Gen [a]
forall a b. (a -> b) -> a -> b
$ Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ m a -> Set a
forall (m :: * -> *) a. Matroid m a => m a -> Set a
groundset m a
m
      let cost :: a -> Int
cost a
x = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
e) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int
forall a. a -> a
id (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
L.elemIndex a
x [a]
e
          optimal :: Set a
optimal = m a -> [a] -> Set a
forall (m :: * -> *) a. Matroid m a => m a -> [a] -> Set a
greedy m a
m [a]
e
          get_cost :: Set a -> Int
get_cost Set a
s = (a -> Int -> Int) -> Int -> Set a -> Int
forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr a -> Int -> Int
add_cost Int
0 Set a
s
          add_cost :: a -> Int -> Int
add_cost a
x Int
c0 = Int
c0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (a -> Int
cost a
x)
          optimal_cost :: Int
optimal_cost = Set a -> Int
get_cost Set a
optimal
          bases :: [Set a]
bases = m a -> [Set a]
forall (m :: * -> *) a. Matroid m a => m a -> [Set a]
enumerateBases m a
m
          not_better_than_optimal :: Set a -> Bool -> Bool
not_better_than_optimal Set a
s = Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> Bool -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Set a -> Int
get_cost Set a
s) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
optimal_cost 
        in Bool -> Gen Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Gen Bool) -> Bool -> Gen Bool
forall a b. (a -> b) -> a -> b
$ (Set a -> Bool -> Bool) -> Bool -> [Set a] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set a -> Bool -> Bool
not_better_than_optimal ((m a -> Set a -> Bool
forall (m :: * -> *) a. Matroid m a => m a -> Set a -> Bool
indep m a
m Set a
optimal) Bool -> Bool -> Bool
&& (m a -> Set a -> Int
forall (m :: * -> *) a. Matroid m a => m a -> Set a -> Int
rk m a
m Set a
optimal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== m a -> Set a -> Int
forall (m :: * -> *) a. Matroid m a => m a -> Set a -> Int
rk m a
m (m a -> Set a
forall (m :: * -> *) a. Matroid m a => m a -> Set a
groundset m a
m))) [Set a]
bases